Theory Complex_Vector_Spaces0
section ‹‹Complex_Vector_Spaces0› -- Vector Spaces and Algebras over the Complex Numbers›
theory Complex_Vector_Spaces0
imports HOL.Real_Vector_Spaces HOL.Topological_Spaces HOL.Vector_Spaces
Complex_Main Jordan_Normal_Form.Conjugate
begin
declare less_complex_def[simp del]
declare less_eq_complex_def[simp del]
subsection ‹Complex vector spaces›
class scaleC = scaleR +
fixes scaleC :: "complex ⇒ 'a ⇒ 'a" (infixr "*⇩C" 75)
assumes scaleR_scaleC: "scaleR r = scaleC (complex_of_real r)"
begin
abbreviation divideC :: "'a ⇒ complex ⇒ 'a" (infixl "'/⇩C" 70)
where "x /⇩C c ≡ inverse c *⇩C x"
end
class complex_vector = scaleC + ab_group_add +
assumes scaleC_add_right: "a *⇩C (x + y) = (a *⇩C x) + (a *⇩C y)"
and scaleC_add_left: "(a + b) *⇩C x = (a *⇩C x) + (b *⇩C x)"
and scaleC_scaleC[simp]: "a *⇩C (b *⇩C x) = (a * b) *⇩C x"
and scaleC_one[simp]: "1 *⇩C x = x"
subclass (in complex_vector) real_vector
by (standard, simp_all add: scaleR_scaleC scaleC_add_right scaleC_add_left)
class complex_algebra = complex_vector + ring +
assumes mult_scaleC_left [simp]: "a *⇩C x * y = a *⇩C (x * y)"
and mult_scaleC_right [simp]: "x * a *⇩C y = a *⇩C (x * y)"
subclass (in complex_algebra) real_algebra
by (standard, simp_all add: scaleR_scaleC)
class complex_algebra_1 = complex_algebra + ring_1
subclass (in complex_algebra_1) real_algebra_1 ..
class complex_div_algebra = complex_algebra_1 + division_ring
subclass (in complex_div_algebra) real_div_algebra ..
class complex_field = complex_div_algebra + field
subclass (in complex_field) real_field ..
instantiation complex :: complex_field
begin
definition complex_scaleC_def [simp]: "scaleC a x = a * x"
instance
proof intro_classes
fix r :: real and a b x y :: complex
show "((*⇩R) r::complex ⇒ _) = (*⇩C) (complex_of_real r)"
by (auto simp add: scaleR_conv_of_real)
show "a *⇩C (x + y) = a *⇩C x + a *⇩C y"
by (simp add: ring_class.ring_distribs(1))
show "(a + b) *⇩C x = a *⇩C x + b *⇩C x"
by (simp add: algebra_simps)
show "a *⇩C b *⇩C x = (a * b) *⇩C x"
by simp
show "1 *⇩C x = x"
by simp
show "a *⇩C (x::complex) * y = a *⇩C (x * y)"
by simp
show "(x::complex) * a *⇩C y = a *⇩C (x * y)"
by simp
qed
end
locale clinear = Vector_Spaces.linear "scaleC::_⇒_⇒'a::complex_vector" "scaleC::_⇒_⇒'b::complex_vector"
begin
lemmas scaleC = scale
end
global_interpretation complex_vector: vector_space "scaleC :: complex ⇒ 'a ⇒ 'a :: complex_vector"
rewrites "Vector_Spaces.linear (*⇩C) (*⇩C) = clinear"
and "Vector_Spaces.linear (*) (*⇩C) = clinear"
defines cdependent_raw_def: cdependent = complex_vector.dependent
and crepresentation_raw_def: crepresentation = complex_vector.representation
and csubspace_raw_def: csubspace = complex_vector.subspace
and cspan_raw_def: cspan = complex_vector.span
and cextend_basis_raw_def: cextend_basis = complex_vector.extend_basis
and cdim_raw_def: cdim = complex_vector.dim
proof unfold_locales
show "Vector_Spaces.linear (*⇩C) (*⇩C) = clinear" "Vector_Spaces.linear (*) (*⇩C) = clinear"
by (force simp: clinear_def complex_scaleC_def[abs_def])+
qed (use scaleC_add_right scaleC_add_left in auto)
abbreviation "cindependent x ≡ ¬ cdependent x"
global_interpretation complex_vector: vector_space_pair "scaleC::_⇒_⇒'a::complex_vector" "scaleC::_⇒_⇒'b::complex_vector"
rewrites "Vector_Spaces.linear (*⇩C) (*⇩C) = clinear"
and "Vector_Spaces.linear (*) (*⇩C) = clinear"
defines cconstruct_raw_def: cconstruct = complex_vector.construct
proof unfold_locales
show "Vector_Spaces.linear (*) (*⇩C) = clinear"
unfolding clinear_def complex_scaleC_def by auto
qed (auto simp: clinear_def)
lemma clinear_compose: "clinear f ⟹ clinear g ⟹ clinear (g ∘ f)"
unfolding clinear_def by (rule Vector_Spaces.linear_compose)
text ‹Recover original theorem names›
lemmas scaleC_left_commute = complex_vector.scale_left_commute
lemmas scaleC_zero_left = complex_vector.scale_zero_left
lemmas scaleC_minus_left = complex_vector.scale_minus_left
lemmas scaleC_diff_left = complex_vector.scale_left_diff_distrib
lemmas scaleC_sum_left = complex_vector.scale_sum_left
lemmas scaleC_zero_right = complex_vector.scale_zero_right
lemmas scaleC_minus_right = complex_vector.scale_minus_right
lemmas scaleC_diff_right = complex_vector.scale_right_diff_distrib
lemmas scaleC_sum_right = complex_vector.scale_sum_right
lemmas scaleC_eq_0_iff = complex_vector.scale_eq_0_iff
lemmas scaleC_left_imp_eq = complex_vector.scale_left_imp_eq
lemmas scaleC_right_imp_eq = complex_vector.scale_right_imp_eq
lemmas scaleC_cancel_left = complex_vector.scale_cancel_left
lemmas scaleC_cancel_right = complex_vector.scale_cancel_right
lemma divideC_field_simps[field_simps]:
"c ≠ 0 ⟹ a = b /⇩C c ⟷ c *⇩C a = b"
"c ≠ 0 ⟹ b /⇩C c = a ⟷ b = c *⇩C a"
"c ≠ 0 ⟹ a + b /⇩C c = (c *⇩C a + b) /⇩C c"
"c ≠ 0 ⟹ a /⇩C c + b = (a + c *⇩C b) /⇩C c"
"c ≠ 0 ⟹ a - b /⇩C c = (c *⇩C a - b) /⇩C c"
"c ≠ 0 ⟹ a /⇩C c - b = (a - c *⇩C b) /⇩C c"
"c ≠ 0 ⟹ - (a /⇩C c) + b = (- a + c *⇩C b) /⇩C c"
"c ≠ 0 ⟹ - (a /⇩C c) - b = (- a - c *⇩C b) /⇩C c"
for a b :: "'a :: complex_vector"
by (auto simp add: scaleC_add_right scaleC_add_left scaleC_diff_right scaleC_diff_left)
text ‹Legacy names -- omitted›
lemmas clinear_injective_0 = linear_inj_iff_eq_0
and clinear_injective_on_subspace_0 = linear_inj_on_iff_eq_0
and clinear_cmul = linear_scale
and clinear_scaleC = linear_scale_self
and csubspace_mul = subspace_scale
and cspan_linear_image = linear_span_image
and cspan_0 = span_zero
and cspan_mul = span_scale
and injective_scaleC = injective_scale
lemma scaleC_minus1_left [simp]: "scaleC (-1) x = - x"
for x :: "'a::complex_vector"
using scaleC_minus_left [of 1 x] by simp
lemma scaleC_2:
fixes x :: "'a::complex_vector"
shows "scaleC 2 x = x + x"
unfolding one_add_one [symmetric] scaleC_add_left by simp
lemma scaleC_half_double [simp]:
fixes a :: "'a::complex_vector"
shows "(1 / 2) *⇩C (a + a) = a"
proof -
have "⋀r. r *⇩C (a + a) = (r * 2) *⇩C a"
by (metis scaleC_2 scaleC_scaleC)
thus ?thesis
by simp
qed
lemma clinear_scale_complex:
fixes c::complex shows "clinear f ⟹ f (c * b) = c * f b"
using complex_vector.linear_scale by fastforce
interpretation scaleC_left: additive "(λa. scaleC a x :: 'a::complex_vector)"
by standard (rule scaleC_add_left)
interpretation scaleC_right: additive "(λx. scaleC a x :: 'a::complex_vector)"
by standard (rule scaleC_add_right)
lemma nonzero_inverse_scaleC_distrib:
"a ≠ 0 ⟹ x ≠ 0 ⟹ inverse (scaleC a x) = scaleC (inverse a) (inverse x)"
for x :: "'a::complex_div_algebra"
by (rule inverse_unique) simp
lemma inverse_scaleC_distrib: "inverse (scaleC a x) = scaleC (inverse a) (inverse x)"
for x :: "'a::{complex_div_algebra,division_ring}"
by (metis inverse_zero nonzero_inverse_scaleC_distrib complex_vector.scale_eq_0_iff)
lemma complex_add_divide_simps[vector_add_divide_simps]:
"v + (b / z) *⇩C w = (if z = 0 then v else (z *⇩C v + b *⇩C w) /⇩C z)"
"a *⇩C v + (b / z) *⇩C w = (if z = 0 then a *⇩C v else ((a * z) *⇩C v + b *⇩C w) /⇩C z)"
"(a / z) *⇩C v + w = (if z = 0 then w else (a *⇩C v + z *⇩C w) /⇩C z)"
"(a / z) *⇩C v + b *⇩C w = (if z = 0 then b *⇩C w else (a *⇩C v + (b * z) *⇩C w) /⇩C z)"
"v - (b / z) *⇩C w = (if z = 0 then v else (z *⇩C v - b *⇩C w) /⇩C z)"
"a *⇩C v - (b / z) *⇩C w = (if z = 0 then a *⇩C v else ((a * z) *⇩C v - b *⇩C w) /⇩C z)"
"(a / z) *⇩C v - w = (if z = 0 then -w else (a *⇩C v - z *⇩C w) /⇩C z)"
"(a / z) *⇩C v - b *⇩C w = (if z = 0 then -b *⇩C w else (a *⇩C v - (b * z) *⇩C w) /⇩C z)"
for v :: "'a :: complex_vector"
by (simp_all add: divide_inverse_commute scaleC_add_right scaleC_diff_right)
lemma ceq_vector_fraction_iff [vector_add_divide_simps]:
fixes x :: "'a :: complex_vector"
shows "(x = (u / v) *⇩C a) ⟷ (if v=0 then x = 0 else v *⇩C x = u *⇩C a)"
by auto (metis (no_types) divide_eq_1_iff divide_inverse_commute scaleC_one scaleC_scaleC)
lemma cvector_fraction_eq_iff [vector_add_divide_simps]:
fixes x :: "'a :: complex_vector"
shows "((u / v) *⇩C a = x) ⟷ (if v=0 then x = 0 else u *⇩C a = v *⇩C x)"
by (metis ceq_vector_fraction_iff)
lemma complex_vector_affinity_eq:
fixes x :: "'a :: complex_vector"
assumes m0: "m ≠ 0"
shows "m *⇩C x + c = y ⟷ x = inverse m *⇩C y - (inverse m *⇩C c)"
(is "?lhs ⟷ ?rhs")
proof
assume ?lhs
hence "m *⇩C x = y - c" by (simp add: field_simps)
hence "inverse m *⇩C (m *⇩C x) = inverse m *⇩C (y - c)" by simp
thus "x = inverse m *⇩C y - (inverse m *⇩C c)"
using m0
by (simp add: complex_vector.scale_right_diff_distrib)
next
assume ?rhs
with m0 show "m *⇩C x + c = y"
by (simp add: complex_vector.scale_right_diff_distrib)
qed
lemma complex_vector_eq_affinity: "m ≠ 0 ⟹ y = m *⇩C x + c ⟷ inverse m *⇩C y - (inverse m *⇩C c) = x"
for x :: "'a::complex_vector"
using complex_vector_affinity_eq[where m=m and x=x and y=y and c=c]
by metis
lemma scaleC_eq_iff [simp]: "b + u *⇩C a = a + u *⇩C b ⟷ a = b ∨ u = 1"
for a :: "'a::complex_vector"
proof (cases "u = 1")
case True
thus ?thesis by auto
next
case False
have "a = b" if "b + u *⇩C a = a + u *⇩C b"
proof -
from that have "(u - 1) *⇩C a = (u - 1) *⇩C b"
by (simp add: algebra_simps)
with False show ?thesis
by auto
qed
thus ?thesis by auto
qed
lemma scaleC_collapse [simp]: "(1 - u) *⇩C a + u *⇩C a = a"
for a :: "'a::complex_vector"
by (simp add: algebra_simps)
subsection ‹Embedding of the Complex Numbers into any ‹complex_algebra_1›: ‹of_complex››
definition of_complex :: "complex ⇒ 'a::complex_algebra_1"
where "of_complex c = scaleC c 1"
lemma scaleC_conv_of_complex: "scaleC r x = of_complex r * x"
by (simp add: of_complex_def)
lemma of_complex_0 [simp]: "of_complex 0 = 0"
by (simp add: of_complex_def)
lemma of_complex_1 [simp]: "of_complex 1 = 1"
by (simp add: of_complex_def)
lemma of_complex_add [simp]: "of_complex (x + y) = of_complex x + of_complex y"
by (simp add: of_complex_def scaleC_add_left)
lemma of_complex_minus [simp]: "of_complex (- x) = - of_complex x"
by (simp add: of_complex_def)
lemma of_complex_diff [simp]: "of_complex (x - y) = of_complex x - of_complex y"
by (simp add: of_complex_def scaleC_diff_left)
lemma of_complex_mult [simp]: "of_complex (x * y) = of_complex x * of_complex y"
by (simp add: of_complex_def mult.commute)
lemma of_complex_sum[simp]: "of_complex (sum f s) = (∑x∈s. of_complex (f x))"
by (induct s rule: infinite_finite_induct) auto
lemma of_complex_prod[simp]: "of_complex (prod f s) = (∏x∈s. of_complex (f x))"
by (induct s rule: infinite_finite_induct) auto
lemma nonzero_of_complex_inverse:
"x ≠ 0 ⟹ of_complex (inverse x) = inverse (of_complex x :: 'a::complex_div_algebra)"
by (simp add: of_complex_def nonzero_inverse_scaleC_distrib)
lemma of_complex_inverse [simp]:
"of_complex (inverse x) = inverse (of_complex x :: 'a::{complex_div_algebra,division_ring})"
by (simp add: of_complex_def inverse_scaleC_distrib)
lemma nonzero_of_complex_divide:
"y ≠ 0 ⟹ of_complex (x / y) = (of_complex x / of_complex y :: 'a::complex_field)"
by (simp add: divide_inverse nonzero_of_complex_inverse)
lemma of_complex_divide [simp]:
"of_complex (x / y) = (of_complex x / of_complex y :: 'a::complex_div_algebra)"
by (simp add: divide_inverse)
lemma of_complex_power [simp]:
"of_complex (x ^ n) = (of_complex x :: 'a::{complex_algebra_1}) ^ n"
by (induct n) simp_all
lemma of_complex_power_int [simp]:
"of_complex (power_int x n) = power_int (of_complex x :: 'a :: {complex_div_algebra,division_ring}) n"
by (auto simp: power_int_def)
lemma of_complex_eq_iff [simp]: "of_complex x = of_complex y ⟷ x = y"
by (simp add: of_complex_def)
lemma inj_of_complex: "inj of_complex"
by (auto intro: injI)
lemmas of_complex_eq_0_iff [simp] = of_complex_eq_iff [of _ 0, simplified]
lemmas of_complex_eq_1_iff [simp] = of_complex_eq_iff [of _ 1, simplified]
lemma minus_of_complex_eq_of_complex_iff [simp]: "-of_complex x = of_complex y ⟷ -x = y"
using of_complex_eq_iff[of "-x" y] by (simp only: of_complex_minus)
lemma of_complex_eq_minus_of_complex_iff [simp]: "of_complex x = -of_complex y ⟷ x = -y"
using of_complex_eq_iff[of x "-y"] by (simp only: of_complex_minus)
lemma of_complex_eq_id [simp]: "of_complex = (id :: complex ⇒ complex)"
by (rule ext) (simp add: of_complex_def)
text ‹Collapse nested embeddings.›
lemma of_complex_of_nat_eq [simp]: "of_complex (of_nat n) = of_nat n"
by (induct n) auto
lemma of_complex_of_int_eq [simp]: "of_complex (of_int z) = of_int z"
by (cases z rule: int_diff_cases) simp
lemma of_complex_numeral [simp]: "of_complex (numeral w) = numeral w"
using of_complex_of_int_eq [of "numeral w"] by simp
lemma of_complex_neg_numeral [simp]: "of_complex (- numeral w) = - numeral w"
using of_complex_of_int_eq [of "- numeral w"] by simp
lemma numeral_power_int_eq_of_complex_cancel_iff [simp]:
"power_int (numeral x) n = (of_complex y :: 'a :: {complex_div_algebra, division_ring}) ⟷
power_int (numeral x) n = y"
proof -
have "power_int (numeral x) n = (of_complex (power_int (numeral x) n) :: 'a)"
by simp
also have "… = of_complex y ⟷ power_int (numeral x) n = y"
by (subst of_complex_eq_iff) auto
finally show ?thesis .
qed
lemma of_complex_eq_numeral_power_int_cancel_iff [simp]:
"(of_complex y :: 'a :: {complex_div_algebra, division_ring}) = power_int (numeral x) n ⟷
y = power_int (numeral x) n"
by (subst (1 2) eq_commute) simp
lemma of_complex_eq_of_complex_power_int_cancel_iff [simp]:
"power_int (of_complex b :: 'a :: {complex_div_algebra, division_ring}) w = of_complex x ⟷
power_int b w = x"
by (metis of_complex_power_int of_complex_eq_iff)
lemma of_complex_in_Ints_iff [simp]: "of_complex x ∈ ℤ ⟷ x ∈ ℤ"
proof safe
fix x assume "(of_complex x :: 'a) ∈ ℤ"
then obtain n where "(of_complex x :: 'a) = of_int n"
by (auto simp: Ints_def)
also have "of_int n = of_complex (of_int n)"
by simp
finally have "x = of_int n"
by (subst (asm) of_complex_eq_iff)
thus "x ∈ ℤ"
by auto
qed (auto simp: Ints_def)
lemma Ints_of_complex [intro]: "x ∈ ℤ ⟹ of_complex x ∈ ℤ"
by simp
text ‹Every complex algebra has characteristic zero.›
lemma fraction_scaleC_times [simp]:
fixes a :: "'a::complex_algebra_1"
shows "(numeral u / numeral v) *⇩C (numeral w * a) = (numeral u * numeral w / numeral v) *⇩C a"
by (metis (no_types, lifting) of_complex_numeral scaleC_conv_of_complex scaleC_scaleC times_divide_eq_left)
lemma inverse_scaleC_times [simp]:
fixes a :: "'a::complex_algebra_1"
shows "(1 / numeral v) *⇩C (numeral w * a) = (numeral w / numeral v) *⇩C a"
by (metis divide_inverse_commute inverse_eq_divide of_complex_numeral scaleC_conv_of_complex scaleC_scaleC)
lemma scaleC_times [simp]:
fixes a :: "'a::complex_algebra_1"
shows "(numeral u) *⇩C (numeral w * a) = (numeral u * numeral w) *⇩C a"
by (simp add: scaleC_conv_of_complex)
subsection ‹The Set of Real Numbers›
definition Complexs :: "'a::complex_algebra_1 set" ("ℂ")
where "ℂ = range of_complex"
lemma Complexs_of_complex [simp]: "of_complex r ∈ ℂ"
by (simp add: Complexs_def)
lemma Complexs_of_int [simp]: "of_int z ∈ ℂ"
by (subst of_complex_of_int_eq [symmetric], rule Complexs_of_complex)
lemma Complexs_of_nat [simp]: "of_nat n ∈ ℂ"
by (subst of_complex_of_nat_eq [symmetric], rule Complexs_of_complex)
lemma Complexs_numeral [simp]: "numeral w ∈ ℂ"
by (subst of_complex_numeral [symmetric], rule Complexs_of_complex)
lemma Complexs_0 [simp]: "0 ∈ ℂ" and Complexs_1 [simp]: "1 ∈ ℂ"
by (simp_all add: Complexs_def)
lemma Complexs_add [simp]: "a ∈ ℂ ⟹ b ∈ ℂ ⟹ a + b ∈ ℂ"
apply (auto simp add: Complexs_def)
by (metis of_complex_add range_eqI)
lemma Complexs_minus [simp]: "a ∈ ℂ ⟹ - a ∈ ℂ"
by (auto simp: Complexs_def)
lemma Complexs_minus_iff [simp]: "- a ∈ ℂ ⟷ a ∈ ℂ"
using Complexs_minus by fastforce
lemma Complexs_diff [simp]: "a ∈ ℂ ⟹ b ∈ ℂ ⟹ a - b ∈ ℂ"
by (metis Complexs_add Complexs_minus_iff add_uminus_conv_diff)
lemma Complexs_mult [simp]: "a ∈ ℂ ⟹ b ∈ ℂ ⟹ a * b ∈ ℂ"
apply (auto simp add: Complexs_def)
by (metis of_complex_mult rangeI)
lemma nonzero_Complexs_inverse: "a ∈ ℂ ⟹ a ≠ 0 ⟹ inverse a ∈ ℂ"
for a :: "'a::complex_div_algebra"
apply (auto simp add: Complexs_def)
by (metis of_complex_inverse range_eqI)
lemma Complexs_inverse: "a ∈ ℂ ⟹ inverse a ∈ ℂ"
for a :: "'a::{complex_div_algebra,division_ring}"
using nonzero_Complexs_inverse by fastforce
lemma Complexs_inverse_iff [simp]: "inverse x ∈ ℂ ⟷ x ∈ ℂ"
for x :: "'a::{complex_div_algebra,division_ring}"
by (metis Complexs_inverse inverse_inverse_eq)
lemma nonzero_Complexs_divide: "a ∈ ℂ ⟹ b ∈ ℂ ⟹ b ≠ 0 ⟹ a / b ∈ ℂ"
for a b :: "'a::complex_field"
by (simp add: divide_inverse)
lemma Complexs_divide [simp]: "a ∈ ℂ ⟹ b ∈ ℂ ⟹ a / b ∈ ℂ"
for a b :: "'a::{complex_field,field}"
using nonzero_Complexs_divide by fastforce
lemma Complexs_power [simp]: "a ∈ ℂ ⟹ a ^ n ∈ ℂ"
for a :: "'a::complex_algebra_1"
apply (auto simp add: Complexs_def)
by (metis range_eqI of_complex_power[symmetric])
lemma Complexs_cases [cases set: Complexs]:
assumes "q ∈ ℂ"
obtains (of_complex) c where "q = of_complex c"
unfolding Complexs_def
proof -
from ‹q ∈ ℂ› have "q ∈ range of_complex" unfolding Complexs_def .
then obtain c where "q = of_complex c" ..
then show thesis ..
qed
lemma sum_in_Complexs [intro,simp]: "(⋀i. i ∈ s ⟹ f i ∈ ℂ) ⟹ sum f s ∈ ℂ"
proof (induct s rule: infinite_finite_induct)
case infinite
then show ?case by (metis Complexs_0 sum.infinite)
qed simp_all
lemma prod_in_Complexs [intro,simp]: "(⋀i. i ∈ s ⟹ f i ∈ ℂ) ⟹ prod f s ∈ ℂ"
proof (induct s rule: infinite_finite_induct)
case infinite
then show ?case by (metis Complexs_1 prod.infinite)
qed simp_all
lemma Complexs_induct [case_names of_complex, induct set: Complexs]:
"q ∈ ℂ ⟹ (⋀r. P (of_complex r)) ⟹ P q"
by (rule Complexs_cases) auto
subsection ‹Ordered complex vector spaces›
class ordered_complex_vector = complex_vector + ordered_ab_group_add +
assumes scaleC_left_mono: "x ≤ y ⟹ 0 ≤ a ⟹ a *⇩C x ≤ a *⇩C y"
and scaleC_right_mono: "a ≤ b ⟹ 0 ≤ x ⟹ a *⇩C x ≤ b *⇩C x"
begin
subclass (in ordered_complex_vector) ordered_real_vector
apply standard
by (auto simp add: less_eq_complex_def scaleC_left_mono scaleC_right_mono scaleR_scaleC)
lemma scaleC_mono:
"a ≤ b ⟹ x ≤ y ⟹ 0 ≤ b ⟹ 0 ≤ x ⟹ a *⇩C x ≤ b *⇩C y"
by (meson order_trans scaleC_left_mono scaleC_right_mono)
lemma scaleC_mono':
"a ≤ b ⟹ c ≤ d ⟹ 0 ≤ a ⟹ 0 ≤ c ⟹ a *⇩C c ≤ b *⇩C d"
by (rule scaleC_mono) (auto intro: order.trans)
lemma pos_le_divideC_eq [field_simps]:
"a ≤ b /⇩C c ⟷ c *⇩C a ≤ b" (is "?P ⟷ ?Q") if "0 < c"
proof
assume ?P
with scaleC_left_mono that have "c *⇩C a ≤ c *⇩C (b /⇩C c)"
using preorder_class.less_imp_le by blast
with that show ?Q
by auto
next
assume ?Q
with scaleC_left_mono that have "c *⇩C a /⇩C c ≤ b /⇩C c"
using less_complex_def less_eq_complex_def by fastforce
with that show ?P
by auto
qed
lemma pos_less_divideC_eq [field_simps]:
"a < b /⇩C c ⟷ c *⇩C a < b" if "c > 0"
using that pos_le_divideC_eq [of c a b]
by (auto simp add: le_less)
lemma pos_divideC_le_eq [field_simps]:
"b /⇩C c ≤ a ⟷ b ≤ c *⇩C a" if "c > 0"
using that pos_le_divideC_eq [of "inverse c" b a]
less_complex_def by auto
lemma pos_divideC_less_eq [field_simps]:
"b /⇩C c < a ⟷ b < c *⇩C a" if "c > 0"
using that pos_less_divideC_eq [of "inverse c" b a]
by (simp add: local.less_le_not_le local.pos_divideC_le_eq local.pos_le_divideC_eq)
lemma pos_le_minus_divideC_eq [field_simps]:
"a ≤ - (b /⇩C c) ⟷ c *⇩C a ≤ - b" if "c > 0"
using that
by (metis local.ab_left_minus local.add.inverse_unique local.add.right_inverse local.add_minus_cancel local.le_minus_iff local.pos_divideC_le_eq local.scaleC_add_right local.scaleC_one local.scaleC_scaleC)
lemma pos_less_minus_divideC_eq [field_simps]:
"a < - (b /⇩C c) ⟷ c *⇩C a < - b" if "c > 0"
using that
by (metis le_less less_le_not_le pos_divideC_le_eq pos_divideC_less_eq pos_le_minus_divideC_eq)
lemma pos_minus_divideC_le_eq [field_simps]:
"- (b /⇩C c) ≤ a ⟷ - b ≤ c *⇩C a" if "c > 0"
using that
by (metis local.add_minus_cancel local.left_minus local.pos_divideC_le_eq local.scaleC_add_right)
lemma pos_minus_divideC_less_eq [field_simps]:
"- (b /⇩C c) < a ⟷ - b < c *⇩C a" if "c > 0"
using that by (simp add: less_le_not_le pos_le_minus_divideC_eq pos_minus_divideC_le_eq)
lemma scaleC_image_atLeastAtMost: "c > 0 ⟹ scaleC c ` {x..y} = {c *⇩C x..c *⇩C y}"
apply (auto intro!: scaleC_left_mono simp: image_iff Bex_def)
by (meson local.eq_iff pos_divideC_le_eq pos_le_divideC_eq)
end
lemma neg_le_divideC_eq [field_simps]:
"a ≤ b /⇩C c ⟷ b ≤ c *⇩C a" (is "?P ⟷ ?Q") if "c < 0"
for a b :: "'a :: ordered_complex_vector"
using that pos_le_divideC_eq [of "- c" a "- b"]
by (simp add: less_complex_def)
lemma neg_less_divideC_eq [field_simps]:
"a < b /⇩C c ⟷ b < c *⇩C a" if "c < 0"
for a b :: "'a :: ordered_complex_vector"
using that neg_le_divideC_eq [of c a b]
by (smt (verit, ccfv_SIG) neg_le_divideC_eq antisym_conv2 complex_vector.scale_minus_right dual_order.strict_implies_order le_less_trans neg_le_iff_le scaleC_scaleC)
lemma neg_divideC_le_eq [field_simps]:
"b /⇩C c ≤ a ⟷ c *⇩C a ≤ b" if "c < 0"
for a b :: "'a :: ordered_complex_vector"
using that pos_divideC_le_eq [of "- c" "- b" a]
by (simp add: less_complex_def)
lemma neg_divideC_less_eq [field_simps]:
"b /⇩C c < a ⟷ c *⇩C a < b" if "c < 0"
for a b :: "'a :: ordered_complex_vector"
using that neg_divideC_le_eq [of c b a]
by (meson neg_le_divideC_eq less_le_not_le)
lemma neg_le_minus_divideC_eq [field_simps]:
"a ≤ - (b /⇩C c) ⟷ - b ≤ c *⇩C a" if "c < 0"
for a b :: "'a :: ordered_complex_vector"
using that pos_le_minus_divideC_eq [of "- c" a "- b"]
by (metis neg_le_divideC_eq complex_vector.scale_minus_right)
lemma neg_less_minus_divideC_eq [field_simps]:
"a < - (b /⇩C c) ⟷ - b < c *⇩C a" if "c < 0"
for a b :: "'a :: ordered_complex_vector"
proof -
have *: "- b = c *⇩C a ⟷ b = - (c *⇩C a)"
by (metis add.inverse_inverse)
from that neg_le_minus_divideC_eq [of c a b]
show ?thesis by (auto simp add: le_less *)
qed
lemma neg_minus_divideC_le_eq [field_simps]:
"- (b /⇩C c) ≤ a ⟷ c *⇩C a ≤ - b" if "c < 0"
for a b :: "'a :: ordered_complex_vector"
using that pos_minus_divideC_le_eq [of "- c" "- b" a]
by (metis Complex_Vector_Spaces0.neg_divideC_le_eq complex_vector.scale_minus_right)
lemma neg_minus_divideC_less_eq [field_simps]:
"- (b /⇩C c) < a ⟷ c *⇩C a < - b" if "c < 0"
for a b :: "'a :: ordered_complex_vector"
using that by (simp add: less_le_not_le neg_le_minus_divideC_eq neg_minus_divideC_le_eq)
lemma divideC_field_splits_simps_1 [field_split_simps]:
"a = b /⇩C c ⟷ (if c = 0 then a = 0 else c *⇩C a = b)"
"b /⇩C c = a ⟷ (if c = 0 then a = 0 else b = c *⇩C a)"
"a + b /⇩C c = (if c = 0 then a else (c *⇩C a + b) /⇩C c)"
"a /⇩C c + b = (if c = 0 then b else (a + c *⇩C b) /⇩C c)"
"a - b /⇩C c = (if c = 0 then a else (c *⇩C a - b) /⇩C c)"
"a /⇩C c - b = (if c = 0 then - b else (a - c *⇩C b) /⇩C c)"
"- (a /⇩C c) + b = (if c = 0 then b else (- a + c *⇩C b) /⇩C c)"
"- (a /⇩C c) - b = (if c = 0 then - b else (- a - c *⇩C b) /⇩C c)"
for a b :: "'a :: complex_vector"
by (auto simp add: field_simps)
lemma divideC_field_splits_simps_2 [field_split_simps]:
"0 < c ⟹ a ≤ b /⇩C c ⟷ (if c > 0 then c *⇩C a ≤ b else if c < 0 then b ≤ c *⇩C a else a ≤ 0)"
"0 < c ⟹ a < b /⇩C c ⟷ (if c > 0 then c *⇩C a < b else if c < 0 then b < c *⇩C a else a < 0)"
"0 < c ⟹ b /⇩C c ≤ a ⟷ (if c > 0 then b ≤ c *⇩C a else if c < 0 then c *⇩C a ≤ b else a ≥ 0)"
"0 < c ⟹ b /⇩C c < a ⟷ (if c > 0 then b < c *⇩C a else if c < 0 then c *⇩C a < b else a > 0)"
"0 < c ⟹ a ≤ - (b /⇩C c) ⟷ (if c > 0 then c *⇩C a ≤ - b else if c < 0 then - b ≤ c *⇩C a else a ≤ 0)"
"0 < c ⟹ a < - (b /⇩C c) ⟷ (if c > 0 then c *⇩C a < - b else if c < 0 then - b < c *⇩C a else a < 0)"
"0 < c ⟹ - (b /⇩C c) ≤ a ⟷ (if c > 0 then - b ≤ c *⇩C a else if c < 0 then c *⇩C a ≤ - b else a ≥ 0)"
"0 < c ⟹ - (b /⇩C c) < a ⟷ (if c > 0 then - b < c *⇩C a else if c < 0 then c *⇩C a < - b else a > 0)"
for a b :: "'a :: ordered_complex_vector"
by (clarsimp intro!: field_simps)+
lemma scaleC_nonneg_nonneg: "0 ≤ a ⟹ 0 ≤ x ⟹ 0 ≤ a *⇩C x"
for x :: "'a::ordered_complex_vector"
using scaleC_left_mono [of 0 x a] by simp
lemma scaleC_nonneg_nonpos: "0 ≤ a ⟹ x ≤ 0 ⟹ a *⇩C x ≤ 0"
for x :: "'a::ordered_complex_vector"
using scaleC_left_mono [of x 0 a] by simp
lemma scaleC_nonpos_nonneg: "a ≤ 0 ⟹ 0 ≤ x ⟹ a *⇩C x ≤ 0"
for x :: "'a::ordered_complex_vector"
using scaleC_right_mono [of a 0 x] by simp
lemma split_scaleC_neg_le: "(0 ≤ a ∧ x ≤ 0) ∨ (a ≤ 0 ∧ 0 ≤ x) ⟹ a *⇩C x ≤ 0"
for x :: "'a::ordered_complex_vector"
by (auto simp: scaleC_nonneg_nonpos scaleC_nonpos_nonneg)
lemma cle_add_iff1: "a *⇩C e + c ≤ b *⇩C e + d ⟷ (a - b) *⇩C e + c ≤ d"
for c d e :: "'a::ordered_complex_vector"
by (simp add: algebra_simps)
lemma cle_add_iff2: "a *⇩C e + c ≤ b *⇩C e + d ⟷ c ≤ (b - a) *⇩C e + d"
for c d e :: "'a::ordered_complex_vector"
by (simp add: algebra_simps)
lemma scaleC_left_mono_neg: "b ≤ a ⟹ c ≤ 0 ⟹ c *⇩C a ≤ c *⇩C b"
for a b :: "'a::ordered_complex_vector"
by (drule scaleC_left_mono [of _ _ "- c"], simp_all add: less_eq_complex_def)
lemma scaleC_right_mono_neg: "b ≤ a ⟹ c ≤ 0 ⟹ a *⇩C c ≤ b *⇩C c"
for c :: "'a::ordered_complex_vector"
by (drule scaleC_right_mono [of _ _ "- c"], simp_all)
lemma scaleC_nonpos_nonpos: "a ≤ 0 ⟹ b ≤ 0 ⟹ 0 ≤ a *⇩C b"
for b :: "'a::ordered_complex_vector"
using scaleC_right_mono_neg [of a 0 b] by simp
lemma split_scaleC_pos_le: "(0 ≤ a ∧ 0 ≤ b) ∨ (a ≤ 0 ∧ b ≤ 0) ⟹ 0 ≤ a *⇩C b"
for b :: "'a::ordered_complex_vector"
by (auto simp: scaleC_nonneg_nonneg scaleC_nonpos_nonpos)
lemma zero_le_scaleC_iff:
fixes b :: "'a::ordered_complex_vector"
assumes "a ∈ ℝ"
shows "0 ≤ a *⇩C b ⟷ 0 < a ∧ 0 ≤ b ∨ a < 0 ∧ b ≤ 0 ∨ a = 0"
(is "?lhs = ?rhs")
proof (cases "a = 0")
case True
then show ?thesis by simp
next
case False
show ?thesis
proof
assume ?lhs
from ‹a ≠ 0› consider "a > 0" | "a < 0"
by (metis assms complex_is_Real_iff less_complex_def less_eq_complex_def not_le order.not_eq_order_implies_strict that(1) zero_complex.sel(2))
then show ?rhs
proof cases
case 1
with ‹?lhs› have "inverse a *⇩C 0 ≤ inverse a *⇩C (a *⇩C b)"
by (metis complex_vector.scale_zero_right ordered_complex_vector_class.pos_le_divideC_eq)
with 1 show ?thesis
by simp
next
case 2
with ‹?lhs› have "- inverse a *⇩C 0 ≤ - inverse a *⇩C (a *⇩C b)"
by (metis Complex_Vector_Spaces0.neg_le_minus_divideC_eq complex_vector.scale_zero_right neg_le_0_iff_le scaleC_left.minus)
with 2 show ?thesis
by simp
qed
next
assume ?rhs
then show ?lhs
using less_imp_le split_scaleC_pos_le by auto
qed
qed
lemma scaleC_le_0_iff:
"a *⇩C b ≤ 0 ⟷ 0 < a ∧ b ≤ 0 ∨ a < 0 ∧ 0 ≤ b ∨ a = 0"
if "a ∈ ℝ"
for b::"'a::ordered_complex_vector"
apply (insert zero_le_scaleC_iff [of "-a" b])
using less_complex_def that by force
lemma scaleC_le_cancel_left: "c *⇩C a ≤ c *⇩C b ⟷ (0 < c ⟶ a ≤ b) ∧ (c < 0 ⟶ b ≤ a)"
if "c ∈ ℝ"
for b :: "'a::ordered_complex_vector"
by (smt (verit, ccfv_threshold) Complex_Vector_Spaces0.neg_divideC_le_eq complex_vector.scale_cancel_left complex_vector.scale_zero_right dual_order.eq_iff dual_order.trans ordered_complex_vector_class.pos_le_divideC_eq that zero_le_scaleC_iff)
lemma scaleC_le_cancel_left_pos: "0 < c ⟹ c *⇩C a ≤ c *⇩C b ⟷ a ≤ b"
for b :: "'a::ordered_complex_vector"
by (simp add: complex_is_Real_iff less_complex_def scaleC_le_cancel_left)
lemma scaleC_le_cancel_left_neg: "c < 0 ⟹ c *⇩C a ≤ c *⇩C b ⟷ b ≤ a"
for b :: "'a::ordered_complex_vector"
by (simp add: complex_is_Real_iff less_complex_def scaleC_le_cancel_left)
lemma scaleC_left_le_one_le: "0 ≤ x ⟹ a ≤ 1 ⟹ a *⇩C x ≤ x"
for x :: "'a::ordered_complex_vector" and a :: complex
using scaleC_right_mono[of a 1 x] by simp
subsection ‹Complex normed vector spaces›
class complex_normed_vector = complex_vector + sgn_div_norm + dist_norm + uniformity_dist + open_uniformity +
real_normed_vector +
assumes norm_scaleC [simp]: "norm (scaleC a x) = cmod a * norm x"
begin
end
class complex_normed_algebra = complex_algebra + complex_normed_vector +
real_normed_algebra
class complex_normed_algebra_1 = complex_algebra_1 + complex_normed_algebra +
real_normed_algebra_1
lemma (in complex_normed_algebra_1) scaleC_power [simp]: "(scaleC x y) ^ n = scaleC (x^n) (y^n)"
by (induct n) (simp_all add: mult_ac)
class complex_normed_div_algebra = complex_div_algebra + complex_normed_vector +
real_normed_div_algebra
class complex_normed_field = complex_field + complex_normed_div_algebra
subclass (in complex_normed_field) real_normed_field ..
instance complex_normed_div_algebra < complex_normed_algebra_1 ..
context complex_normed_vector begin
end
lemma dist_scaleC [simp]: "dist (x *⇩C a) (y *⇩C a) = ¦x - y¦ * norm a"
for a :: "'a::complex_normed_vector"
by (metis dist_scaleR scaleR_scaleC)
lemma norm_of_complex [simp]: "norm (of_complex c :: 'a::complex_normed_algebra_1) = cmod c"
by (simp add: of_complex_def)
lemma norm_of_complex_add1 [simp]: "norm (of_complex x + 1 :: 'a :: complex_normed_div_algebra) = cmod (x + 1)"
by (metis norm_of_complex of_complex_1 of_complex_add)
lemma norm_of_complex_addn [simp]:
"norm (of_complex x + numeral b :: 'a :: complex_normed_div_algebra) = cmod (x + numeral b)"
by (metis norm_of_complex of_complex_add of_complex_numeral)
lemma norm_of_complex_diff [simp]:
"norm (of_complex b - of_complex a :: 'a::complex_normed_algebra_1) ≤ cmod (b - a)"
by (metis norm_of_complex of_complex_diff order_refl)
subsection ‹Metric spaces›
text ‹Every normed vector space is a metric space.›
subsection ‹Class instances for complex numbers›
instantiation complex :: complex_normed_field
begin
instance
apply intro_classes
by (simp add: norm_mult)
end
declare uniformity_Abort[where 'a=complex, code]
lemma dist_of_complex [simp]: "dist (of_complex x :: 'a) (of_complex y) = dist x y"
for a :: "'a::complex_normed_div_algebra"
by (metis dist_norm norm_of_complex of_complex_diff)
declare [[code abort: "open :: complex set ⇒ bool"]]
lemma closed_complex_atMost: ‹closed {..a::complex}›
proof -
have ‹{..a} = Im -` {Im a} ∩ Re -` {..Re a}›
by (auto simp: less_eq_complex_def)
also have ‹closed …›
by (auto intro!: closed_Int closed_vimage continuous_on_Im continuous_on_Re)
finally show ?thesis
by -
qed
lemma closed_complex_atLeast: ‹closed {a::complex..}›
proof -
have ‹{a..} = Im -` {Im a} ∩ Re -` {Re a..}›
by (auto simp: less_eq_complex_def)
also have ‹closed …›
by (auto intro!: closed_Int closed_vimage continuous_on_Im continuous_on_Re)
finally show ?thesis
by -
qed
lemma closed_complex_atLeastAtMost: ‹closed {a::complex .. b}›
proof (cases ‹Im a = Im b›)
case True
have ‹{a..b} = Im -` {Im a} ∩ Re -` {Re a..Re b}›
by (auto simp add: less_eq_complex_def intro!: True)
also have ‹closed …›
by (auto intro!: closed_Int closed_vimage continuous_on_Im continuous_on_Re)
finally show ?thesis
by -
next
case False
then have *: ‹{a..b} = {}›
using less_eq_complex_def by auto
show ?thesis
by (simp add: *)
qed
subsection ‹Sign function›
lemma sgn_scaleC: "sgn (scaleC r x) = scaleC (sgn r) (sgn x)"
for x :: "'a::complex_normed_vector"
by (simp add: scaleR_scaleC sgn_div_norm ac_simps)
lemma sgn_of_complex: "sgn (of_complex r :: 'a::complex_normed_algebra_1) = of_complex (sgn r)"
unfolding of_complex_def by (simp only: sgn_scaleC sgn_one)
lemma complex_sgn_eq: "sgn x = x / ¦x¦"
for x :: complex
by (simp add: abs_complex_def scaleR_scaleC sgn_div_norm divide_inverse)
lemma czero_le_sgn_iff [simp]: "0 ≤ sgn x ⟷ 0 ≤ x"
for x :: complex
using cmod_eq_Re divide_eq_0_iff less_eq_complex_def by auto
lemma csgn_le_0_iff [simp]: "sgn x ≤ 0 ⟷ x ≤ 0"
for x :: complex
by (smt (verit, best) czero_le_sgn_iff Im_sgn Re_sgn divide_eq_0_iff dual_order.eq_iff less_eq_complex_def sgn_zero_iff zero_complex.sel(1) zero_complex.sel(2))
subsection ‹Bounded Linear and Bilinear Operators›
lemma clinearI: "clinear f"
if "⋀b1 b2. f (b1 + b2) = f b1 + f b2"
"⋀r b. f (r *⇩C b) = r *⇩C f b"
using that
by unfold_locales (auto simp: algebra_simps)
lemma clinear_iff:
"clinear f ⟷ (∀x y. f (x + y) = f x + f y) ∧ (∀c x. f (c *⇩C x) = c *⇩C f x)"
(is "clinear f ⟷ ?rhs")
proof
assume "clinear f"
then interpret f: clinear f .
show "?rhs"
by (simp add: f.add f.scale complex_vector.linear_scale f.clinear_axioms)
next
assume "?rhs"
then show "clinear f" by (intro clinearI) auto
qed
lemmas clinear_scaleC_left = complex_vector.linear_scale_left
lemmas clinear_imp_scaleC = complex_vector.linear_imp_scale
corollary complex_clinearD:
fixes f :: "complex ⇒ complex"
assumes "clinear f" obtains c where "f = (*) c"
by (rule clinear_imp_scaleC [OF assms]) (force simp: scaleC_conv_of_complex)
lemma clinear_times_of_complex: "clinear (λx. a * of_complex x)"
by (auto intro!: clinearI simp: distrib_left)
(metis mult_scaleC_right scaleC_conv_of_complex)
locale bounded_clinear = clinear f for f :: "'a::complex_normed_vector ⇒ 'b::complex_normed_vector" +
assumes bounded: "∃K. ∀x. norm (f x) ≤ norm x * K"
begin
lemma bounded_linear: "bounded_linear f"
apply standard
by (simp_all add: add scaleC scaleR_scaleC bounded)
lemma pos_bounded: "∃K>0. ∀x. norm (f x) ≤ norm x * K"
proof -
obtain K where K: "⋀x. norm (f x) ≤ norm x * K"
using bounded by blast
show ?thesis
proof (intro exI impI conjI allI)
show "0 < max 1 K"
by (rule order_less_le_trans [OF zero_less_one max.cobounded1])
next
fix x
have "norm (f x) ≤ norm x * K" using K .
also have "… ≤ norm x * max 1 K"
by (rule mult_left_mono [OF max.cobounded2 norm_ge_zero])
finally show "norm (f x) ≤ norm x * max 1 K" .
qed
qed
lemma nonneg_bounded: "∃K≥0. ∀x. norm (f x) ≤ norm x * K"
by (meson less_imp_le pos_bounded)
lemma clinear: "clinear f"
by (fact local.clinear_axioms)
end
lemma bounded_clinear_intro:
assumes "⋀x y. f (x + y) = f x + f y"
and "⋀r x. f (scaleC r x) = scaleC r (f x)"
and "⋀x. norm (f x) ≤ norm x * K"
shows "bounded_clinear f"
by standard (blast intro: assms)+
locale bounded_cbilinear =
fixes prod :: "'a::complex_normed_vector ⇒ 'b::complex_normed_vector ⇒ 'c::complex_normed_vector"
(infixl "**" 70)
assumes add_left: "prod (a + a') b = prod a b + prod a' b"
and add_right: "prod a (b + b') = prod a b + prod a b'"
and scaleC_left: "prod (scaleC r a) b = scaleC r (prod a b)"
and scaleC_right: "prod a (scaleC r b) = scaleC r (prod a b)"
and bounded: "∃K. ∀a b. norm (prod a b) ≤ norm a * norm b * K"
begin
lemma bounded_bilinear[simp]: "bounded_bilinear prod"
apply standard
by (auto simp add: add_left add_right scaleR_scaleC scaleC_left scaleC_right bounded)
interpretation bounded_bilinear prod
by simp
lemmas pos_bounded = pos_bounded
lemmas nonneg_bounded = nonneg_bounded
lemmas additive_right = additive_right
lemmas additive_left = additive_left
lemmas zero_left = zero_left
lemmas zero_right = zero_right
lemmas minus_left = minus_left
lemmas minus_right = minus_right
lemmas diff_left = diff_left
lemmas diff_right = diff_right
lemmas sum_left = sum_left
lemmas sum_right = sum_right
lemmas prod_diff_prod = prod_diff_prod
lemma bounded_clinear_left: "bounded_clinear (λa. a ** b)"
proof -
obtain K where "⋀a b. norm (a ** b) ≤ norm a * norm b * K"
using pos_bounded by blast
then show ?thesis
by (rule_tac K="norm b * K" in bounded_clinear_intro) (auto simp: algebra_simps scaleC_left add_left)
qed
lemma bounded_clinear_right: "bounded_clinear (λb. a ** b)"
proof -
obtain K where "⋀a b. norm (a ** b) ≤ norm a * norm b * K"
using pos_bounded by blast
then show ?thesis
by (rule_tac K="norm a * K" in bounded_clinear_intro) (auto simp: algebra_simps scaleC_right add_right)
qed
lemma flip: "bounded_cbilinear (λx y. y ** x)"
proof
show "∃K. ∀a b. norm (b ** a) ≤ norm a * norm b * K"
by (metis bounded mult.commute)
qed (simp_all add: add_right add_left scaleC_right scaleC_left)
lemma comp1:
assumes "bounded_clinear g"
shows "bounded_cbilinear (λx. (**) (g x))"
proof
interpret g: bounded_clinear g by fact
show "⋀a a' b. g (a + a') ** b = g a ** b + g a' ** b"
"⋀a b b'. g a ** (b + b') = g a ** b + g a ** b'"
"⋀r a b. g (r *⇩C a) ** b = r *⇩C (g a ** b)"
"⋀a r b. g a ** (r *⇩C b) = r *⇩C (g a ** b)"
by (auto simp: g.add add_left add_right g.scaleC scaleC_left scaleC_right)
have "bounded_bilinear (λa b. g a ** b)"
using g.bounded_linear by (rule comp1)
then show "∃K. ∀a b. norm (g a ** b) ≤ norm a * norm b * K"
by (rule bounded_bilinear.bounded)
qed
lemma comp: "bounded_clinear f ⟹ bounded_clinear g ⟹ bounded_cbilinear (λx y. f x ** g y)"
by (rule bounded_cbilinear.flip[OF bounded_cbilinear.comp1[OF bounded_cbilinear.flip[OF comp1]]])
end
lemma bounded_clinear_ident[simp]: "bounded_clinear (λx. x)"
by standard (auto intro!: exI[of _ 1])
lemma bounded_clinear_zero[simp]: "bounded_clinear (λx. 0)"
by standard (auto intro!: exI[of _ 1])
lemma bounded_clinear_add:
assumes "bounded_clinear f"
and "bounded_clinear g"
shows "bounded_clinear (λx. f x + g x)"
proof -
interpret f: bounded_clinear f by fact
interpret g: bounded_clinear g by fact
show ?thesis
proof
from f.bounded obtain Kf where Kf: "norm (f x) ≤ norm x * Kf" for x
by blast
from g.bounded obtain Kg where Kg: "norm (g x) ≤ norm x * Kg" for x
by blast
show "∃K. ∀x. norm (f x + g x) ≤ norm x * K"
using add_mono[OF Kf Kg]
by (intro exI[of _ "Kf + Kg"]) (auto simp: field_simps intro: norm_triangle_ineq order_trans)
qed (simp_all add: f.add g.add f.scaleC g.scaleC scaleC_add_right)
qed
lemma bounded_clinear_minus:
assumes "bounded_clinear f"
shows "bounded_clinear (λx. - f x)"
proof -
interpret f: bounded_clinear f by fact
show ?thesis
by unfold_locales (simp_all add: f.add f.scaleC f.bounded)
qed
lemma bounded_clinear_sub: "bounded_clinear f ⟹ bounded_clinear g ⟹ bounded_clinear (λx. f x - g x)"
using bounded_clinear_add[of f "λx. - g x"] bounded_clinear_minus[of g]
by (auto simp: algebra_simps)
lemma bounded_clinear_sum:
fixes f :: "'i ⇒ 'a::complex_normed_vector ⇒ 'b::complex_normed_vector"
shows "(⋀i. i ∈ I ⟹ bounded_clinear (f i)) ⟹ bounded_clinear (λx. ∑i∈I. f i x)"
by (induct I rule: infinite_finite_induct) (auto intro!: bounded_clinear_add)
lemma bounded_clinear_compose:
assumes "bounded_clinear f"
and "bounded_clinear g"
shows "bounded_clinear (λx. f (g x))"
proof
interpret f: bounded_clinear f by fact
interpret g: bounded_clinear g by fact
show "f (g (x + y)) = f (g x) + f (g y)" for x y
by (simp only: f.add g.add)
show "f (g (scaleC r x)) = scaleC r (f (g x))" for r x
by (simp only: f.scaleC g.scaleC)
from f.pos_bounded obtain Kf where f: "⋀x. norm (f x) ≤ norm x * Kf" and Kf: "0 < Kf"
by blast
from g.pos_bounded obtain Kg where g: "⋀x. norm (g x) ≤ norm x * Kg"
by blast
show "∃K. ∀x. norm (f (g x)) ≤ norm x * K"
proof (intro exI allI)
fix x
have "norm (f (g x)) ≤ norm (g x) * Kf"
using f .
also have "… ≤ (norm x * Kg) * Kf"
using g Kf [THEN order_less_imp_le] by (rule mult_right_mono)
also have "(norm x * Kg) * Kf = norm x * (Kg * Kf)"
by (rule mult.assoc)
finally show "norm (f (g x)) ≤ norm x * (Kg * Kf)" .
qed
qed
lemma bounded_cbilinear_mult: "bounded_cbilinear ((*) :: 'a ⇒ 'a ⇒ 'a::complex_normed_algebra)"
proof (rule bounded_cbilinear.intro)
show "∃K. ∀a b::'a. norm (a * b) ≤ norm a * norm b * K"
by (rule_tac x=1 in exI) (simp add: norm_mult_ineq)
qed (auto simp: algebra_simps)
lemma bounded_clinear_mult_left: "bounded_clinear (λx::'a::complex_normed_algebra. x * y)"
using bounded_cbilinear_mult
by (rule bounded_cbilinear.bounded_clinear_left)
lemma bounded_clinear_mult_right: "bounded_clinear (λy::'a::complex_normed_algebra. x * y)"
using bounded_cbilinear_mult
by (rule bounded_cbilinear.bounded_clinear_right)
lemmas bounded_clinear_mult_const =
bounded_clinear_mult_left [THEN bounded_clinear_compose]
lemmas bounded_clinear_const_mult =
bounded_clinear_mult_right [THEN bounded_clinear_compose]
lemma bounded_clinear_divide: "bounded_clinear (λx. x / y)"
for y :: "'a::complex_normed_field"
unfolding divide_inverse by (rule bounded_clinear_mult_left)
lemma bounded_cbilinear_scaleC: "bounded_cbilinear scaleC"
proof (rule bounded_cbilinear.intro)
obtain K where K: ‹∀a (b::'a). norm b ≤ norm b * K›
using less_eq_real_def by auto
show "∃K. ∀a (b::'a). norm (a *⇩C b) ≤ norm a * norm b * K"
apply (rule exI[where x=K]) using K
by (metis norm_scaleC)
qed (auto simp: algebra_simps)
lemma bounded_clinear_scaleC_left: "bounded_clinear (λc. scaleC c x)"
using bounded_cbilinear_scaleC
by (rule bounded_cbilinear.bounded_clinear_left)
lemma bounded_clinear_scaleC_right: "bounded_clinear (λx. scaleC c x)"
using bounded_cbilinear_scaleC
by (rule bounded_cbilinear.bounded_clinear_right)
lemmas bounded_clinear_scaleC_const =
bounded_clinear_scaleC_left[THEN bounded_clinear_compose]
lemmas bounded_clinear_const_scaleC =
bounded_clinear_scaleC_right[THEN bounded_clinear_compose]
lemma bounded_clinear_of_complex: "bounded_clinear (λr. of_complex r)"
unfolding of_complex_def by (rule bounded_clinear_scaleC_left)
lemma complex_bounded_clinear: "bounded_clinear f ⟷ (∃c::complex. f = (λx. x * c))"
for f :: "complex ⇒ complex"
proof -
{
fix x
assume "bounded_clinear f"
then interpret bounded_clinear f .
from scaleC[of x 1] have "f x = x * f 1"
by simp
}
then show ?thesis
by (auto intro: exI[of _ "f 1"] bounded_clinear_mult_left)
qed
subsubsection ‹Limits of Sequences›
subsection ‹Cauchy sequences›
lemma cCauchy_iff2: "Cauchy X ⟷ (∀j. (∃M. ∀m ≥ M. ∀n ≥ M. cmod (X m - X n) < inverse (real (Suc j))))"
by (simp only: metric_Cauchy_iff2 dist_complex_def)
subsection ‹The set of real numbers is a complete metric space›
text ‹
Proof that Cauchy sequences converge based on the one from
🌐‹http://pirate.shu.edu/~wachsmut/ira/numseq/proofs/cauconv.html›
›
text ‹
If sequence \<^term>‹X› is Cauchy, then its limit is the lub of
\<^term>‹{r::real. ∃N. ∀n≥N. r < X n}›
›
lemma complex_increasing_LIMSEQ:
fixes f :: "nat ⇒ complex"
assumes inc: "⋀n. f n ≤ f (Suc n)"
and bdd: "⋀n. f n ≤ l"
and en: "⋀e. 0 < e ⟹ ∃n. l ≤ f n + e"
shows "f ⇢ l"
proof -
have ‹(λn. Re (f n)) ⇢ Re l›
apply (rule increasing_LIMSEQ)
using assms apply (auto simp: less_eq_complex_def less_complex_def)
by (metis Im_complex_of_real Re_complex_of_real)
moreover have ‹Im (f n) = Im l› for n
using bdd by (auto simp: less_eq_complex_def)
then have ‹(λn. Im (f n)) ⇢ Im l›
by auto
ultimately show ‹f ⇢ l›
by (simp add: tendsto_complex_iff)
qed
lemma complex_Cauchy_convergent:
fixes X :: "nat ⇒ complex"
assumes X: "Cauchy X"
shows "convergent X"
using assms by (rule Cauchy_convergent)
instance complex :: complete_space
by intro_classes (rule complex_Cauchy_convergent)
class cbanach = complex_normed_vector + complete_space
subclass (in cbanach) banach ..
instance complex :: banach ..
end
Theory Complex_Vector_Spaces
section ‹‹Complex_Vector_Spaces› -- Complex Vector Spaces›
theory Complex_Vector_Spaces
imports
"HOL-Analysis.Elementary_Topology"
"HOL-Analysis.Operator_Norm"
"HOL-Analysis.Elementary_Normed_Spaces"
"HOL-Library.Set_Algebras"
"HOL-Analysis.Starlike"
"HOL-Types_To_Sets.Types_To_Sets"
"Complex_Bounded_Operators.Extra_Vector_Spaces"
"Complex_Bounded_Operators.Extra_Ordered_Fields"
"Complex_Bounded_Operators.Extra_Lattice"
"Complex_Bounded_Operators.Extra_General"
Complex_Vector_Spaces0
begin
bundle notation_norm begin
notation norm ("∥_∥")
end
subsection ‹Misc›
lemma (in scaleC) scaleC_real: assumes "r∈ℝ" shows "r *⇩C x = Re r *⇩R x"
unfolding scaleR_scaleC using assms by simp
lemma of_complex_of_real_eq [simp]: "of_complex (of_real n) = of_real n"
unfolding of_complex_def of_real_def unfolding scaleR_scaleC by simp
lemma Complexs_of_real [simp]: "of_real r ∈ ℂ"
unfolding Complexs_def of_real_def of_complex_def
apply (subst scaleR_scaleC) by simp
lemma Reals_in_Complexs: "ℝ ⊆ ℂ"
unfolding Reals_def by auto
lemma (in clinear) "linear f"
apply standard
by (simp_all add: add scaleC scaleR_scaleC)
lemma (in bounded_clinear) bounded_linear: "bounded_linear f"
by (simp add: add bounded bounded_linear.intro bounded_linear_axioms.intro linearI scaleC scaleR_scaleC)
lemma clinear_times: "clinear (λx. c * x)"
for c :: "'a::complex_algebra"
by (auto simp: clinearI distrib_left)
lemma (in clinear) linear:
shows ‹linear f›
by (simp add: add linearI scaleC scaleR_scaleC)
lemma bounded_clinearI:
assumes ‹⋀b1 b2. f (b1 + b2) = f b1 + f b2›
assumes ‹⋀r b. f (r *⇩C b) = r *⇩C f b›
assumes ‹∀x. norm (f x) ≤ norm x * K›
shows "bounded_clinear f"
using assms by (auto intro!: exI bounded_clinear.intro clinearI simp: bounded_clinear_axioms_def)
lemma bounded_clinear_id[simp]: ‹bounded_clinear id›
by (simp add: id_def)
definition cbilinear :: ‹('a::complex_vector ⇒ 'b::complex_vector ⇒ 'c::complex_vector) ⇒ bool›
where ‹cbilinear = (λ f. (∀ y. clinear (λ x. f x y)) ∧ (∀ x. clinear (λ y. f x y)) )›
lemma cbilinear_add_left:
assumes ‹cbilinear f›
shows ‹f (a + b) c = f a c + f b c›
by (smt (verit, del_insts) assms cbilinear_def complex_vector.linear_add)
lemma cbilinear_add_right:
assumes ‹cbilinear f›
shows ‹f a (b + c) = f a b + f a c›
by (smt (verit, del_insts) assms cbilinear_def complex_vector.linear_add)
lemma cbilinear_times:
fixes g' :: ‹'a::complex_vector ⇒ complex› and g :: ‹'b::complex_vector ⇒ complex›
assumes ‹⋀ x y. h x y = (g' x)*(g y)› and ‹clinear g› and ‹clinear g'›
shows ‹cbilinear h›
proof -
have w1: "h (b1 + b2) y = h b1 y + h b2 y"
for b1 :: 'a
and b2 :: 'a
and y
proof-
have ‹h (b1 + b2) y = g' (b1 + b2) * g y›
using ‹⋀ x y. h x y = (g' x)*(g y)›
by auto
also have ‹… = (g' b1 + g' b2) * g y›
using ‹clinear g'›
unfolding clinear_def
by (simp add: assms(3) complex_vector.linear_add)
also have ‹… = g' b1 * g y + g' b2 * g y›
by (simp add: ring_class.ring_distribs(2))
also have ‹… = h b1 y + h b2 y›
using assms(1) by auto
finally show ?thesis by blast
qed
have w2: "h (r *⇩C b) y = r *⇩C h b y"
for r :: complex
and b :: 'a
and y
proof-
have ‹h (r *⇩C b) y = g' (r *⇩C b) * g y›
by (simp add: assms(1))
also have ‹… = r *⇩C (g' b * g y)›
by (simp add: assms(3) complex_vector.linear_scale)
also have ‹… = r *⇩C (h b y)›
by (simp add: assms(1))
finally show ?thesis by blast
qed
have "clinear (λx. h x y)"
for y :: 'b
unfolding clinear_def
by (meson clinearI clinear_def w1 w2)
hence t2: "∀y. clinear (λx. h x y)"
by simp
have v1: "h x (b1 + b2) = h x b1 + h x b2"
for b1 :: 'b
and b2 :: 'b
and x
proof-
have ‹h x (b1 + b2) = g' x * g (b1 + b2)›
using ‹⋀ x y. h x y = (g' x)*(g y)›
by auto
also have ‹… = g' x * (g b1 + g b2)›
using ‹clinear g'›
unfolding clinear_def
by (simp add: assms(2) complex_vector.linear_add)
also have ‹… = g' x * g b1 + g' x * g b2›
by (simp add: ring_class.ring_distribs(1))
also have ‹… = h x b1 + h x b2›
using assms(1) by auto
finally show ?thesis by blast
qed
have v2: "h x (r *⇩C b) = r *⇩C h x b"
for r :: complex
and b :: 'b
and x
proof-
have ‹h x (r *⇩C b) = g' x * g (r *⇩C b)›
by (simp add: assms(1))
also have ‹… = r *⇩C (g' x * g b)›
by (simp add: assms(2) complex_vector.linear_scale)
also have ‹… = r *⇩C (h x b)›
by (simp add: assms(1))
finally show ?thesis by blast
qed
have "Vector_Spaces.linear (*⇩C) (*⇩C) (h x)"
for x :: 'a
using v1 v2
by (meson clinearI clinear_def)
hence t1: "∀x. clinear (h x)"
unfolding clinear_def
by simp
show ?thesis
unfolding cbilinear_def
by (simp add: t1 t2)
qed
lemma csubspace_is_subspace: "csubspace A ⟹ subspace A"
apply (rule subspaceI)
by (auto simp: complex_vector.subspace_def scaleR_scaleC)
lemma span_subset_cspan: "span A ⊆ cspan A"
unfolding span_def complex_vector.span_def
by (simp add: csubspace_is_subspace hull_antimono)
lemma cindependent_implies_independent:
assumes "cindependent (S::'a::complex_vector set)"
shows "independent S"
using assms unfolding dependent_def complex_vector.dependent_def
using span_subset_cspan by blast
lemma cspan_singleton: "cspan {x} = {α *⇩C x| α. True}"
proof -
have ‹cspan {x} = {y. y∈cspan {x}}›
by auto
also have ‹… = {α *⇩C x| α. True}›
apply (subst complex_vector.span_breakdown_eq)
by auto
finally show ?thesis
by -
qed
lemma cspan_as_span:
"cspan (B::'a::complex_vector set) = span (B ∪ scaleC 𝗂 ` B)"
proof auto
let ?cspan = complex_vector.span
let ?rspan = real_vector.span
fix ψ
assume cspan: "ψ ∈ ?cspan B"
have "∃B' r. finite B' ∧ B' ⊆ B ∧ ψ = (∑b∈B'. r b *⇩C b)"
using complex_vector.span_explicit[of B] cspan
by auto
then obtain B' r where "finite B'" and "B' ⊆ B" and ψ_explicit: "ψ = (∑b∈B'. r b *⇩C b)"
by atomize_elim
define R where "R = B ∪ scaleC 𝗂 ` B"
have x2: "(case x of (b, i) ⇒ if i
then Im (r b) *⇩R 𝗂 *⇩C b
else Re (r b) *⇩R b) ∈ span (B ∪ (*⇩C) 𝗂 ` B)"
if "x ∈ B' × (UNIV::bool set)"
for x :: "'a × bool"
using that ‹B' ⊆ B› by (auto simp add: real_vector.span_base real_vector.span_scale subset_iff)
have x1: "ψ = (∑x∈B'. ∑i∈UNIV. if i then Im (r x) *⇩R 𝗂 *⇩C x else Re (r x) *⇩R x)"
if "⋀b. r b *⇩C b = Re (r b) *⇩R b + Im (r b) *⇩R 𝗂 *⇩C b"
using that by (simp add: UNIV_bool ψ_explicit)
moreover have "r b *⇩C b = Re (r b) *⇩R b + Im (r b) *⇩R 𝗂 *⇩C b" for b
using complex_eq scaleC_add_left scaleC_scaleC scaleR_scaleC
by (metis (no_types, lifting) complex_of_real_i i_complex_of_real)
ultimately have "ψ = (∑(b,i)∈(B'×UNIV). if i then Im (r b) *⇩R (𝗂 *⇩C b) else Re (r b) *⇩R b)"
by (simp add: sum.cartesian_product)
also have "… ∈ ?rspan R"
unfolding R_def
using x2
by (rule real_vector.span_sum)
finally show "ψ ∈ ?rspan R" by -
next
let ?cspan = complex_vector.span
let ?rspan = real_vector.span
define R where "R = B ∪ scaleC 𝗂 ` B"
fix ψ
assume rspan: "ψ ∈ ?rspan R"
have "subspace {a. a ∈ cspan B}"
by (rule real_vector.subspaceI, auto simp add: complex_vector.span_zero
complex_vector.span_add_eq2 complex_vector.span_scale scaleR_scaleC)
moreover have "x ∈ cspan B"
if "x ∈ R"
for x :: 'a
using that R_def complex_vector.span_base complex_vector.span_scale by fastforce
ultimately show "ψ ∈ ?cspan B"
using real_vector.span_induct rspan by blast
qed
lemma isomorphic_equal_cdim:
assumes lin_f: ‹clinear f›
assumes inj_f: ‹inj_on f (cspan S)›
assumes im_S: ‹f ` S = T›
shows ‹cdim S = cdim T›
proof -
obtain SB where SB_span: "cspan SB = cspan S" and indep_SB: ‹cindependent SB›
by (metis complex_vector.basis_exists complex_vector.span_mono complex_vector.span_span subset_antisym)
with lin_f inj_f have indep_fSB: ‹cindependent (f ` SB)›
apply (rule_tac complex_vector.linear_independent_injective_image)
by auto
from lin_f have ‹cspan (f ` SB) = f ` cspan SB›
by (meson complex_vector.linear_span_image)
also from SB_span lin_f have ‹… = cspan T›
by (metis complex_vector.linear_span_image im_S)
finally have ‹cdim T = card (f ` SB)›
using indep_fSB complex_vector.dim_eq_card by blast
also have ‹… = card SB›
apply (rule card_image) using inj_f
by (metis SB_span complex_vector.linear_inj_on_span_iff_independent_image indep_fSB lin_f)
also have ‹… = cdim S›
using indep_SB SB_span
by (metis complex_vector.dim_eq_card)
finally show ?thesis by simp
qed
lemma cindependent_inter_scaleC_cindependent:
assumes a1: "cindependent (B::'a::complex_vector set)" and a3: "c ≠ 1"
shows "B ∩ (*⇩C) c ` B = {}"
proof (rule classical, cases ‹c = 0›)
case True
then show ?thesis
using a1 by (auto simp add: complex_vector.dependent_zero)
next
case False
assume "¬(B ∩ (*⇩C) c ` B = {})"
hence "B ∩ (*⇩C) c ` B ≠ {}"
by blast
then obtain x where u1: "x ∈ B ∩ (*⇩C) c ` B"
by blast
then obtain b where u2: "x = b" and u3: "b∈B"
by blast
then obtain b' where u2': "x = c *⇩C b'" and u3': "b'∈B"
using u1
by blast
have g1: "b = c *⇩C b'"
using u2 and u2' by simp
hence "b ∈ complex_vector.span {b'}"
using False
by (simp add: complex_vector.span_base complex_vector.span_scale)
hence "b = b'"
by (metis u3' a1 complex_vector.dependent_def complex_vector.span_base
complex_vector.span_scale insertE insert_Diff u2 u2' u3)
hence "b' = c *⇩C b'"
using g1 by blast
thus ?thesis
by (metis a1 a3 complex_vector.dependent_zero complex_vector.scale_right_imp_eq
mult_cancel_right2 scaleC_scaleC u3')
qed
lemma real_independent_from_complex_independent:
assumes "cindependent (B::'a::complex_vector set)"
defines "B' == ((*⇩C) 𝗂 ` B)"
shows "independent (B ∪ B')"
proof (rule notI)
assume ‹dependent (B ∪ B')›
then obtain T f0 x where [simp]: ‹finite T› and ‹T ⊆ B ∪ B'› and f0_sum: ‹(∑v∈T. f0 v *⇩R v) = 0›
and x: ‹x ∈ T› and f0_x: ‹f0 x ≠ 0›
by (auto simp: real_vector.dependent_explicit)
define f T1 T2 T' f' x' where ‹f v = (if v ∈ T then f0 v else 0)›
and ‹T1 = T ∩ B› and ‹T2 = scaleC (-𝗂) ` (T ∩ B')›
and ‹T' = T1 ∪ T2› and ‹f' v = f v + 𝗂 * f (𝗂 *⇩C v)›
and ‹x' = (if x ∈ T1 then x else -𝗂 *⇩C x)› for v
have ‹B ∩ B' = {}›
by (simp add: assms cindependent_inter_scaleC_cindependent)
have ‹T' ⊆ B›
by (auto simp: T'_def T1_def T2_def B'_def)
have [simp]: ‹finite T'› ‹finite T1› ‹finite T2›
by (auto simp add: T'_def T1_def T2_def)
have f_sum: ‹(∑v∈T. f v *⇩R v) = 0›
unfolding f_def using f0_sum by auto
have f_x: ‹f x ≠ 0›
using f0_x x by (auto simp: f_def)
have f'_sum: ‹(∑v∈T'. f' v *⇩C v) = 0›
proof -
have ‹(∑v∈T'. f' v *⇩C v) = (∑v∈T'. complex_of_real (f v) *⇩C v) + (∑v∈T'. (𝗂 * complex_of_real (f (𝗂 *⇩C v))) *⇩C v)›
by (auto simp: f'_def sum.distrib scaleC_add_left)
also have ‹(∑v∈T'. complex_of_real (f v) *⇩C v) = (∑v∈T1. f v *⇩R v)› (is ‹_ = ?left›)
apply (auto simp: T'_def scaleR_scaleC intro!: sum.mono_neutral_cong_right)
using T'_def T1_def ‹T' ⊆ B› f_def by auto
also have ‹(∑v∈T'. (𝗂 * complex_of_real (f (𝗂 *⇩C v))) *⇩C v) = (∑v∈T2. (𝗂 * complex_of_real (f (𝗂 *⇩C v))) *⇩C v)› (is ‹_ = ?right›)
apply (auto simp: T'_def intro!: sum.mono_neutral_cong_right)
by (smt (z3) B'_def IntE IntI T1_def T2_def ‹f ≡ λv. if v ∈ T then f0 v else 0› add.inverse_inverse complex_vector.vector_space_axioms i_squared imageI mult_minus_left vector_space.vector_space_assms(3) vector_space.vector_space_assms(4))
also have ‹?right = (∑v∈T∩B'. f v *⇩R v)› (is ‹_ = ?right›)
apply (rule sum.reindex_cong[symmetric, where l=‹scaleC 𝗂›])
apply (auto simp: T2_def image_image scaleR_scaleC)
using inj_on_def by fastforce
also have ‹?left + ?right = (∑v∈T. f v *⇩R v)›
apply (subst sum.union_disjoint[symmetric])
using ‹B ∩ B' = {}› ‹T ⊆ B ∪ B'› apply (auto simp: T1_def)
by (metis Int_Un_distrib Un_Int_eq(4) sup.absorb_iff1)
also have ‹… = 0›
by (rule f_sum)
finally show ?thesis
by -
qed
have x': ‹x' ∈ T'›
using ‹T ⊆ B ∪ B'› x by (auto simp: x'_def T'_def T1_def T2_def)
have f'_x': ‹f' x' ≠ 0›
using Complex_eq Complex_eq_0 f'_def f_x x'_def by auto
from ‹finite T'› ‹T' ⊆ B› f'_sum x' f'_x'
have ‹cdependent B›
using complex_vector.independent_explicit_module by blast
with assms show False
by auto
qed
lemma crepresentation_from_representation:
assumes a1: "cindependent B" and a2: "b ∈ B" and a3: "finite B"
shows "crepresentation B ψ b = (representation (B ∪ (*⇩C) 𝗂 ` B) ψ b)
+ 𝗂 *⇩C (representation (B ∪ (*⇩C) 𝗂 ` B) ψ (𝗂 *⇩C b))"
proof (cases "ψ ∈ cspan B")
define B' where "B' = B ∪ (*⇩C) 𝗂 ` B"
case True
define r where "r v = real_vector.representation B' ψ v" for v
define r' where "r' v = real_vector.representation B' ψ (𝗂 *⇩C v)" for v
define f where "f v = r v + 𝗂 *⇩C r' v" for v
define g where "g v = crepresentation B ψ v" for v
have "(∑v | g v ≠ 0. g v *⇩C v) = ψ"
unfolding g_def
using Collect_cong Collect_mono_iff DiffD1 DiffD2 True a1
complex_vector.finite_representation
complex_vector.sum_nonzero_representation_eq sum.mono_neutral_cong_left
by fastforce
moreover have "finite {v. g v ≠ 0}"
unfolding g_def
by (simp add: complex_vector.finite_representation)
moreover have "v ∈ B"
if "g v ≠ 0" for v
using that unfolding g_def
by (simp add: complex_vector.representation_ne_zero)
ultimately have rep1: "(∑v∈B. g v *⇩C v) = ψ"
unfolding g_def
using a3 True a1 complex_vector.sum_representation_eq by blast
have l0': "inj ((*⇩C) 𝗂::'a ⇒'a)"
unfolding inj_def
by simp
have l0: "inj ((*⇩C) (- 𝗂)::'a ⇒'a)"
unfolding inj_def
by simp
have l1: "(*⇩C) (- 𝗂) ` B ∩ B = {}"
using cindependent_inter_scaleC_cindependent[where B=B and c = "- 𝗂"]
by (metis Int_commute a1 add.inverse_inverse complex_i_not_one i_squared mult_cancel_left1
neg_equal_0_iff_equal)
have l2: "B ∩ (*⇩C) 𝗂 ` B = {}"
by (simp add: a1 cindependent_inter_scaleC_cindependent)
have rr1: "r (𝗂 *⇩C v) = r' v" for v
unfolding r_def r'_def
by simp
have k1: "independent B'"
unfolding B'_def using a1 real_independent_from_complex_independent by simp
have "ψ ∈ span B'"
using B'_def True cspan_as_span by blast
have "v ∈ B'"
if "r v ≠ 0"
for v
unfolding r_def
using r_def real_vector.representation_ne_zero that by auto
have "finite B'"
unfolding B'_def using a3
by simp
have "(∑v∈B'. r v *⇩R v) = ψ"
unfolding r_def
using True Real_Vector_Spaces.real_vector.sum_representation_eq[where B = B' and basis = B'
and v = ψ]
by (smt Real_Vector_Spaces.dependent_raw_def ‹ψ ∈ Real_Vector_Spaces.span B'› ‹finite B'›
equalityD2 k1)
have d1: "(∑v∈B. r (𝗂 *⇩C v) *⇩R (𝗂 *⇩C v)) = (∑v∈(*⇩C) 𝗂 ` B. r v *⇩R v)"
using l0'
by (metis (mono_tags, lifting) inj_eq inj_on_def sum.reindex_cong)
have "(∑v∈B. (r v + 𝗂 * (r' v)) *⇩C v) = (∑v∈B. r v *⇩C v + (𝗂 * r' v) *⇩C v)"
by (meson scaleC_left.add)
also have "… = (∑v∈B. r v *⇩C v) + (∑v∈B. (𝗂 * r' v) *⇩C v)"
using sum.distrib by fastforce
also have "… = (∑v∈B. r v *⇩C v) + (∑v∈B. 𝗂 *⇩C (r' v *⇩C v))"
by auto
also have "… = (∑v∈B. r v *⇩R v) + (∑v∈B. 𝗂 *⇩C (r (𝗂 *⇩C v) *⇩R v))"
unfolding r'_def r_def
by (metis (mono_tags, lifting) scaleR_scaleC sum.cong)
also have "… = (∑v∈B. r v *⇩R v) + (∑v∈B. r (𝗂 *⇩C v) *⇩R (𝗂 *⇩C v))"
by (metis (no_types, lifting) complex_vector.scale_left_commute scaleR_scaleC)
also have "… = (∑v∈B. r v *⇩R v) + (∑v∈(*⇩C) 𝗂 ` B. r v *⇩R v)"
using d1
by simp
also have "… = ψ"
using l2 ‹(∑v∈B'. r v *⇩R v) = ψ›
unfolding B'_def
by (simp add: a3 sum.union_disjoint)
finally have "(∑v∈B. f v *⇩C v) = ψ" unfolding r'_def r_def f_def by simp
hence "0 = (∑v∈B. f v *⇩C v) - (∑v∈B. crepresentation B ψ v *⇩C v)"
using rep1
unfolding g_def
by simp
also have "… = (∑v∈B. f v *⇩C v - crepresentation B ψ v *⇩C v)"
by (simp add: sum_subtractf)
also have "… = (∑v∈B. (f v - crepresentation B ψ v) *⇩C v)"
by (metis scaleC_left.diff)
finally have "0 = (∑v∈B. (f v - crepresentation B ψ v) *⇩C v)".
hence "(∑v∈B. (f v - crepresentation B ψ v) *⇩C v) = 0"
by simp
hence "f b - crepresentation B ψ b = 0"
using a1 a2 a3 complex_vector.independentD[where s = B and t = B
and u = "λv. f v - crepresentation B ψ v" and v = b]
order_refl by smt
hence "crepresentation B ψ b = f b"
by simp
thus ?thesis unfolding f_def r_def r'_def B'_def by auto
next
define B' where "B' = B ∪ (*⇩C) 𝗂 ` B"
case False
have b2: "ψ ∉ real_vector.span B'"
unfolding B'_def
using False cspan_as_span by auto
have "ψ ∉ complex_vector.span B"
using False by blast
have "crepresentation B ψ b = 0"
unfolding complex_vector.representation_def
by (simp add: False)
moreover have "real_vector.representation B' ψ b = 0"
unfolding real_vector.representation_def
by (simp add: b2)
moreover have "real_vector.representation B' ψ ((*⇩C) 𝗂 b) = 0"
unfolding real_vector.representation_def
by (simp add: b2)
ultimately show ?thesis unfolding B'_def by simp
qed
lemma CARD_1_vec_0[simp]: ‹(ψ :: _ ::{complex_vector,CARD_1}) = 0›
by auto
lemma scaleC_cindependent:
assumes a1: "cindependent (B::'a::complex_vector set)" and a3: "c ≠ 0"
shows "cindependent ((*⇩C) c ` B)"
proof-
have "u y = 0"
if g1: "y∈S" and g2: "(∑x∈S. u x *⇩C x) = 0" and g3: "finite S" and g4: "S⊆(*⇩C) c ` B"
for u y S
proof-
define v where "v x = u (c *⇩C x)" for x
obtain S' where "S'⊆B" and S_S': "S = (*⇩C) c ` S'"
by (meson g4 subset_imageE)
have "inj ((*⇩C) c::'a⇒_)"
unfolding inj_def
using a3 by auto
hence "finite S'"
using S_S' finite_imageD g3 subset_inj_on by blast
have "t ∈ (*⇩C) (inverse c) ` S"
if "t ∈ S'" for t
proof-
have "c *⇩C t ∈ S"
using ‹S = (*⇩C) c ` S'› that by blast
hence "(inverse c) *⇩C (c *⇩C t) ∈ (*⇩C) (inverse c) ` S"
by blast
moreover have "(inverse c) *⇩C (c *⇩C t) = t"
by (simp add: a3)
ultimately show ?thesis by simp
qed
moreover have "t ∈ S'"
if "t ∈ (*⇩C) (inverse c) ` S" for t
proof-
obtain t' where "t = (inverse c) *⇩C t'" and "t' ∈ S"
using ‹t ∈ (*⇩C) (inverse c) ` S› by auto
have "c *⇩C t = c *⇩C ((inverse c) *⇩C t')"
using ‹t = (inverse c) *⇩C t'› by simp
also have "… = (c * (inverse c)) *⇩C t'"
by simp
also have "… = t'"
by (simp add: a3)
finally have "c *⇩C t = t'".
thus ?thesis using ‹t' ∈ S›
using ‹S = (*⇩C) c ` S'› a3 complex_vector.scale_left_imp_eq by blast
qed
ultimately have "S' = (*⇩C) (inverse c) ` S"
by blast
hence "inverse c *⇩C y ∈ S'"
using that(1) by blast
have t: "inj (((*⇩C) c)::'a ⇒ _)"
using a3 complex_vector.injective_scale[where c = c]
by blast
have "0 = (∑x∈(*⇩C) c ` S'. u x *⇩C x)"
using ‹S = (*⇩C) c ` S'› that(2) by auto
also have "… = (∑x∈S'. v x *⇩C (c *⇩C x))"
unfolding v_def
using t Groups_Big.comm_monoid_add_class.sum.reindex[where h = "((*⇩C) c)" and A = S'
and g = "λx. u x *⇩C x"] subset_inj_on by auto
also have "… = c *⇩C (∑x∈S'. v x *⇩C x)"
by (metis (mono_tags, lifting) complex_vector.scale_left_commute scaleC_right.sum sum.cong)
finally have "0 = c *⇩C (∑x∈S'. v x *⇩C x)".
hence "(∑x∈S'. v x *⇩C x) = 0"
using a3 by auto
hence "v (inverse c *⇩C y) = 0"
using ‹inverse c *⇩C y ∈ S'› ‹finite S'› ‹S' ⊆ B› a1
complex_vector.independentD
by blast
thus "u y = 0"
unfolding v_def
by (simp add: a3)
qed
thus ?thesis
using complex_vector.dependent_explicit
by (simp add: complex_vector.dependent_explicit )
qed
subsection ‹Antilinear maps and friends›
locale antilinear = additive f for f :: "'a::complex_vector ⇒ 'b::complex_vector" +
assumes scaleC: "f (scaleC r x) = cnj r *⇩C f x"
sublocale antilinear ⊆ linear
proof (rule linearI)
show "f (b1 + b2) = f b1 + f b2"
for b1 :: 'a
and b2 :: 'a
by (simp add: add)
show "f (r *⇩R b) = r *⇩R f b"
for r :: real
and b :: 'a
unfolding scaleR_scaleC by (subst scaleC, simp)
qed
lemma antilinear_imp_scaleC:
fixes D :: "complex ⇒ 'a::complex_vector"
assumes "antilinear D"
obtains d where "D = (λx. cnj x *⇩C d)"
proof -
interpret clinear "D o cnj"
apply standard apply auto
apply (simp add: additive.add assms antilinear.axioms(1))
using assms antilinear.scaleC by fastforce
obtain d where "D o cnj = (λx. x *⇩C d)"
using clinear_axioms complex_vector.linear_imp_scale by blast
then have ‹D = (λx. cnj x *⇩C d)›
by (metis comp_apply complex_cnj_cnj)
then show ?thesis
by (rule that)
qed
corollary complex_antilinearD:
fixes f :: "complex ⇒ complex"
assumes "antilinear f" obtains c where "f = (λx. c * cnj x)"
by (rule antilinear_imp_scaleC [OF assms]) (force simp: scaleC_conv_of_complex)
lemma antilinearI:
assumes "⋀x y. f (x + y) = f x + f y"
and "⋀c x. f (c *⇩C x) = cnj c *⇩C f x"
shows "antilinear f"
by standard (rule assms)+
lemma antilinear_o_antilinear: "antilinear f ⟹ antilinear g ⟹ clinear (g o f)"
apply (rule clinearI)
apply (simp add: additive.add antilinear_def)
by (simp add: antilinear.scaleC)
lemma clinear_o_antilinear: "antilinear f ⟹ clinear g ⟹ antilinear (g o f)"
apply (rule antilinearI)
apply (simp add: additive.add complex_vector.linear_add antilinear_def)
by (simp add: complex_vector.linear_scale antilinear.scaleC)
lemma antilinear_o_clinear: "clinear f ⟹ antilinear g ⟹ antilinear (g o f)"
apply (rule antilinearI)
apply (simp add: additive.add complex_vector.linear_add antilinear_def)
by (simp add: complex_vector.linear_scale antilinear.scaleC)
locale bounded_antilinear = antilinear f for f :: "'a::complex_normed_vector ⇒ 'b::complex_normed_vector" +
assumes bounded: "∃K. ∀x. norm (f x) ≤ norm x * K"
lemma bounded_antilinearI:
assumes ‹⋀b1 b2. f (b1 + b2) = f b1 + f b2›
assumes ‹⋀r b. f (r *⇩C b) = cnj r *⇩C f b›
assumes ‹∀x. norm (f x) ≤ norm x * K›
shows "bounded_antilinear f"
using assms by (auto intro!: exI bounded_antilinear.intro antilinearI simp: bounded_antilinear_axioms_def)
sublocale bounded_antilinear ⊆ bounded_linear
apply standard by (fact bounded)
lemma (in bounded_antilinear) bounded_linear: "bounded_linear f"
by (fact bounded_linear)
lemma (in bounded_antilinear) antilinear: "antilinear f"
by (fact antilinear_axioms)
lemma bounded_antilinear_intro:
assumes "⋀x y. f (x + y) = f x + f y"
and "⋀r x. f (scaleC r x) = scaleC (cnj r) (f x)"
and "⋀x. norm (f x) ≤ norm x * K"
shows "bounded_antilinear f"
by standard (blast intro: assms)+
lemma bounded_antilinear_0[simp]: ‹bounded_antilinear (λ_. 0)›
by (rule bounded_antilinear_intro[where K=0], auto)
lemma cnj_bounded_antilinear[simp]: "bounded_antilinear cnj"
apply (rule bounded_antilinear_intro [where K = 1])
by auto
lemma bounded_antilinear_o_bounded_antilinear:
assumes "bounded_antilinear f"
and "bounded_antilinear g"
shows "bounded_clinear (λx. f (g x))"
proof
interpret f: bounded_antilinear f by fact
interpret g: bounded_antilinear g by fact
fix b1 b2 b r
show "f (g (b1 + b2)) = f (g b1) + f (g b2)"
by (simp add: f.add g.add)
show "f (g (r *⇩C b)) = r *⇩C f (g b)"
by (simp add: f.scaleC g.scaleC)
have "bounded_linear (λx. f (g x))"
using f.bounded_linear g.bounded_linear by (rule bounded_linear_compose)
then show "∃K. ∀x. norm (f (g x)) ≤ norm x * K"
by (rule bounded_linear.bounded)
qed
lemma bounded_antilinear_o_bounded_clinear:
assumes "bounded_antilinear f"
and "bounded_clinear g"
shows "bounded_antilinear (λx. f (g x))"
proof
interpret f: bounded_antilinear f by fact
interpret g: bounded_clinear g by fact
show "f (g (x + y)) = f (g x) + f (g y)" for x y
by (simp only: f.add g.add)
show "f (g (scaleC r x)) = scaleC (cnj r) (f (g x))" for r x
by (simp add: f.scaleC g.scaleC)
have "bounded_linear (λx. f (g x))"
using f.bounded_linear g.bounded_linear by (rule bounded_linear_compose)
then show "∃K. ∀x. norm (f (g x)) ≤ norm x * K"
by (rule bounded_linear.bounded)
qed
lemma bounded_clinear_o_bounded_antilinear:
assumes "bounded_clinear f"
and "bounded_antilinear g"
shows "bounded_antilinear (λx. f (g x))"
proof
interpret f: bounded_clinear f by fact
interpret g: bounded_antilinear g by fact
show "f (g (x + y)) = f (g x) + f (g y)" for x y
by (simp only: f.add g.add)
show "f (g (scaleC r x)) = scaleC (cnj r) (f (g x))" for r x
using f.scaleC g.scaleC by fastforce
have "bounded_linear (λx. f (g x))"
using f.bounded_linear g.bounded_linear by (rule bounded_linear_compose)
then show "∃K. ∀x. norm (f (g x)) ≤ norm x * K"
by (rule bounded_linear.bounded)
qed
lemma bij_clinear_imp_inv_clinear: "clinear (inv f)"
if a1: "clinear f" and a2: "bij f"
proof
fix b1 b2 r b
show "inv f (b1 + b2) = inv f b1 + inv f b2"
by (simp add: a1 a2 bij_is_inj bij_is_surj complex_vector.linear_add inv_f_eq surj_f_inv_f)
show "inv f (r *⇩C b) = r *⇩C inv f b"
using that
by (smt bij_inv_eq_iff clinear_def complex_vector.linear_scale)
qed
locale bounded_sesquilinear =
fixes
prod :: "'a::complex_normed_vector ⇒ 'b::complex_normed_vector ⇒ 'c::complex_normed_vector"
(infixl "**" 70)
assumes add_left: "prod (a + a') b = prod a b + prod a' b"
and add_right: "prod a (b + b') = prod a b + prod a b'"
and scaleC_left: "prod (r *⇩C a) b = (cnj r) *⇩C (prod a b)"
and scaleC_right: "prod a (r *⇩C b) = r *⇩C (prod a b)"
and bounded: "∃K. ∀a b. norm (prod a b) ≤ norm a * norm b * K"
sublocale bounded_sesquilinear ⊆ bounded_bilinear
apply standard
by (auto simp: add_left add_right scaleC_left scaleC_right bounded scaleR_scaleC)
lemma (in bounded_sesquilinear) bounded_bilinear[simp]: "bounded_bilinear prod"
by (fact bounded_bilinear_axioms)
lemma (in bounded_sesquilinear) bounded_antilinear_left: "bounded_antilinear (λa. prod a b)"
apply standard
apply (auto simp add: scaleC_left add_left)
by (metis ab_semigroup_mult_class.mult_ac(1) bounded)
lemma (in bounded_sesquilinear) bounded_clinear_right: "bounded_clinear (λb. prod a b)"
apply standard
apply (auto simp add: scaleC_right add_right)
by (metis ab_semigroup_mult_class.mult_ac(1) ordered_field_class.sign_simps(34) pos_bounded)
lemma (in bounded_sesquilinear) comp1:
assumes ‹bounded_clinear g›
shows ‹bounded_sesquilinear (λx. prod (g x))›
proof
interpret bounded_clinear g by fact
fix a a' b b' r
show "prod (g (a + a')) b = prod (g a) b + prod (g a') b"
by (simp add: add add_left)
show "prod (g a) (b + b') = prod (g a) b + prod (g a) b'"
by (simp add: add add_right)
show "prod (g (r *⇩C a)) b = cnj r *⇩C prod (g a) b"
by (simp add: scaleC scaleC_left)
show "prod (g a) (r *⇩C b) = r *⇩C prod (g a) b"
by (simp add: scaleC_right)
interpret bounded_bilinear ‹(λx. prod (g x))›
by (simp add: bounded_linear comp1)
show "∃K. ∀a b. norm (prod (g a) b) ≤ norm a * norm b * K"
using bounded by blast
qed
lemma (in bounded_sesquilinear) comp2:
assumes ‹bounded_clinear g›
shows ‹bounded_sesquilinear (λx y. prod x (g y))›
proof
interpret bounded_clinear g by fact
fix a a' b b' r
show "prod (a + a') (g b) = prod a (g b) + prod a' (g b)"
by (simp add: add add_left)
show "prod a (g (b + b')) = prod a (g b) + prod a (g b')"
by (simp add: add add_right)
show "prod (r *⇩C a) (g b) = cnj r *⇩C prod a (g b)"
by (simp add: scaleC scaleC_left)
show "prod a (g (r *⇩C b)) = r *⇩C prod a (g b)"
by (simp add: scaleC scaleC_right)
interpret bounded_bilinear ‹(λx y. prod x (g y))›
apply (rule bounded_bilinear.flip)
using _ bounded_linear apply (rule bounded_bilinear.comp1)
using bounded_bilinear by (rule bounded_bilinear.flip)
show "∃K. ∀a b. norm (prod a (g b)) ≤ norm a * norm b * K"
using bounded by blast
qed
lemma (in bounded_sesquilinear) comp: "bounded_clinear f ⟹ bounded_clinear g ⟹ bounded_sesquilinear (λx y. prod (f x) (g y))"
using comp1 bounded_sesquilinear.comp2 by auto
lemma bounded_clinear_const_scaleR:
fixes c :: real
assumes ‹bounded_clinear f›
shows ‹bounded_clinear (λ x. c *⇩R f x )›
proof-
have ‹bounded_clinear (λ x. (complex_of_real c) *⇩C f x )›
by (simp add: assms bounded_clinear_const_scaleC)
thus ?thesis
by (simp add: scaleR_scaleC)
qed
lemma bounded_linear_bounded_clinear:
‹bounded_linear A ⟹ ∀c x. A (c *⇩C x) = c *⇩C A x ⟹ bounded_clinear A›
apply standard
by (simp_all add: linear_simps bounded_linear.bounded)
lemma comp_bounded_clinear:
fixes A :: ‹'b::complex_normed_vector ⇒ 'c::complex_normed_vector›
and B :: ‹'a::complex_normed_vector ⇒ 'b›
assumes ‹bounded_clinear A› and ‹bounded_clinear B›
shows ‹bounded_clinear (A ∘ B)›
by (metis clinear_compose assms(1) assms(2) bounded_clinear_axioms_def bounded_clinear_compose bounded_clinear_def o_def)
lemmas isCont_scaleC [simp] =
bounded_bilinear.isCont [OF bounded_cbilinear_scaleC[THEN bounded_cbilinear.bounded_bilinear]]
subsection ‹Misc 2›
lemmas sums_of_complex = bounded_linear.sums [OF bounded_clinear_of_complex[THEN bounded_clinear.bounded_linear]]
lemmas summable_of_complex = bounded_linear.summable [OF bounded_clinear_of_complex[THEN bounded_clinear.bounded_linear]]
lemmas suminf_of_complex = bounded_linear.suminf [OF bounded_clinear_of_complex[THEN bounded_clinear.bounded_linear]]
lemmas sums_scaleC_left = bounded_linear.sums[OF bounded_clinear_scaleC_left[THEN bounded_clinear.bounded_linear]]
lemmas summable_scaleC_left = bounded_linear.summable[OF bounded_clinear_scaleC_left[THEN bounded_clinear.bounded_linear]]
lemmas suminf_scaleC_left = bounded_linear.suminf[OF bounded_clinear_scaleC_left[THEN bounded_clinear.bounded_linear]]
lemmas sums_scaleC_right = bounded_linear.sums[OF bounded_clinear_scaleC_right[THEN bounded_clinear.bounded_linear]]
lemmas summable_scaleC_right = bounded_linear.summable[OF bounded_clinear_scaleC_right[THEN bounded_clinear.bounded_linear]]
lemmas suminf_scaleC_right = bounded_linear.suminf[OF bounded_clinear_scaleC_right[THEN bounded_clinear.bounded_linear]]
lemma closed_scaleC:
fixes S::‹'a::complex_normed_vector set› and a :: complex
assumes ‹closed S›
shows ‹closed ((*⇩C) a ` S)›
proof (cases ‹a = 0›)
case True
then show ?thesis
apply (cases ‹S = {}›)
by (auto simp: image_constant)
next
case False
then have ‹(*⇩C) a ` S = (*⇩C) (inverse a) -` S›
by (auto simp add: rev_image_eqI)
moreover have ‹closed ((*⇩C) (inverse a) -` S)›
by (simp add: assms continuous_closed_vimage)
ultimately show ?thesis
by simp
qed
lemma closure_scaleC:
fixes S::‹'a::complex_normed_vector set›
shows ‹closure ((*⇩C) a ` S) = (*⇩C) a ` closure S›
proof
have ‹closed (closure S)›
by simp
show "closure ((*⇩C) a ` S) ⊆ (*⇩C) a ` closure S"
by (simp add: closed_scaleC closure_minimal closure_subset image_mono)
have "x ∈ closure ((*⇩C) a ` S)"
if "x ∈ (*⇩C) a ` closure S"
for x :: 'a
proof-
obtain t where ‹x = ((*⇩C) a) t› and ‹t ∈ closure S›
using ‹x ∈ (*⇩C) a ` closure S› by auto
have ‹∃s. (∀n. s n ∈ S) ∧ s ⇢ t›
using ‹t ∈ closure S› Elementary_Topology.closure_sequential
by blast
then obtain s where ‹∀n. s n ∈ S› and ‹s ⇢ t›
by blast
have ‹(∀ n. scaleC a (s n) ∈ ((*⇩C) a ` S))›
using ‹∀n. s n ∈ S› by blast
moreover have ‹(λ n. scaleC a (s n)) ⇢ x›
proof-
have ‹isCont (scaleC a) t›
by simp
thus ?thesis
using ‹s ⇢ t› ‹x = ((*⇩C) a) t›
by (simp add: isCont_tendsto_compose)
qed
ultimately show ?thesis using Elementary_Topology.closure_sequential
by metis
qed
thus "(*⇩C) a ` closure S ⊆ closure ((*⇩C) a ` S)" by blast
qed
lemma onorm_scalarC:
fixes f :: ‹'a::complex_normed_vector ⇒ 'b::complex_normed_vector›
assumes a1: ‹bounded_clinear f›
shows ‹onorm (λ x. r *⇩C (f x)) = (cmod r) * onorm f›
proof-
have ‹(norm (f x)) / norm x ≤ onorm f›
for x
using a1
by (simp add: bounded_clinear.bounded_linear le_onorm)
hence t2: ‹bdd_above {(norm (f x)) / norm x | x. True}›
by fastforce
have ‹continuous_on UNIV ( (*) w ) ›
for w::real
by simp
hence ‹isCont ( ((*) (cmod r)) ) x›
for x
by simp
hence t3: ‹continuous (at_left (Sup {(norm (f x)) / norm x | x. True})) ((*) (cmod r))›
using Elementary_Topology.continuous_at_imp_continuous_within
by blast
have ‹{(norm (f x)) / norm x | x. True} ≠ {}›
by blast
moreover have ‹mono ((*) (cmod r))›
by (simp add: monoI ordered_comm_semiring_class.comm_mult_left_mono)
ultimately have ‹Sup {((*) (cmod r)) ((norm (f x)) / norm x) | x. True}
= ((*) (cmod r)) (Sup {(norm (f x)) / norm x | x. True})›
using t2 t3
by (simp add: continuous_at_Sup_mono full_SetCompr_eq image_image)
hence ‹Sup {(cmod r) * ((norm (f x)) / norm x) | x. True}
= (cmod r) * (Sup {(norm (f x)) / norm x | x. True})›
by blast
moreover have ‹Sup {(cmod r) * ((norm (f x)) / norm x) | x. True}
= (SUP x. cmod r * norm (f x) / norm x)›
by (simp add: full_SetCompr_eq)
moreover have ‹(Sup {(norm (f x)) / norm x | x. True})
= (SUP x. norm (f x) / norm x)›
by (simp add: full_SetCompr_eq)
ultimately have t1: "(SUP x. cmod r * norm (f x) / norm x)
= cmod r * (SUP x. norm (f x) / norm x)"
by simp
have ‹onorm (λ x. r *⇩C (f x)) = (SUP x. norm ( (λ t. r *⇩C (f t)) x) / norm x)›
by (simp add: onorm_def)
hence ‹onorm (λ x. r *⇩C (f x)) = (SUP x. (cmod r) * (norm (f x)) / norm x)›
by simp
also have ‹... = (cmod r) * (SUP x. (norm (f x)) / norm x)›
using t1.
finally show ?thesis
by (simp add: onorm_def)
qed
lemma onorm_scaleC_left_lemma:
fixes f :: "'a::complex_normed_vector"
assumes r: "bounded_clinear r"
shows "onorm (λx. r x *⇩C f) ≤ onorm r * norm f"
proof (rule onorm_bound)
fix x
have "norm (r x *⇩C f) = norm (r x) * norm f"
by simp
also have "… ≤ onorm r * norm x * norm f"
by (simp add: bounded_clinear.bounded_linear mult.commute mult_left_mono onorm r)
finally show "norm (r x *⇩C f) ≤ onorm r * norm f * norm x"
by (simp add: ac_simps)
show "0 ≤ onorm r * norm f"
by (simp add: bounded_clinear.bounded_linear onorm_pos_le r)
qed
lemma onorm_scaleC_left:
fixes f :: "'a::complex_normed_vector"
assumes f: "bounded_clinear r"
shows "onorm (λx. r x *⇩C f) = onorm r * norm f"
proof (cases "f = 0")
assume "f ≠ 0"
show ?thesis
proof (rule order_antisym)
show "onorm (λx. r x *⇩C f) ≤ onorm r * norm f"
using f by (rule onorm_scaleC_left_lemma)
next
have bl1: "bounded_clinear (λx. r x *⇩C f)"
by (metis bounded_clinear_scaleC_const f)
have x1:"bounded_clinear (λx. r x * norm f)"
by (metis bounded_clinear_mult_const f)
have "onorm r ≤ onorm (λx. r x * complex_of_real (norm f)) / norm f"
if "onorm r ≤ onorm (λx. r x * complex_of_real (norm f)) * cmod (1 / complex_of_real (norm f))"
and "f ≠ 0"
using that
by (metis complex_of_real_cmod complex_of_real_nn_iff field_class.field_divide_inverse
inverse_eq_divide nice_ordered_field_class.zero_le_divide_1_iff norm_ge_zero of_real_1
of_real_divide of_real_eq_iff)
hence "onorm r ≤ onorm (λx. r x * norm f) * inverse (norm f)"
using ‹f ≠ 0› onorm_scaleC_left_lemma[OF x1, of "inverse (norm f)"]
by (simp add: inverse_eq_divide)
also have "onorm (λx. r x * norm f) ≤ onorm (λx. r x *⇩C f)"
proof (rule onorm_bound)
have "bounded_linear (λx. r x *⇩C f)"
using bl1 bounded_clinear.bounded_linear by auto
thus "0 ≤ onorm (λx. r x *⇩C f)"
by (rule Operator_Norm.onorm_pos_le)
show "cmod (r x * complex_of_real (norm f)) ≤ onorm (λx. r x *⇩C f) * norm x"
for x :: 'b
by (smt ‹bounded_linear (λx. r x *⇩C f)› complex_of_real_cmod complex_of_real_nn_iff
complex_scaleC_def norm_ge_zero norm_scaleC of_real_eq_iff onorm)
qed
finally show "onorm r * norm f ≤ onorm (λx. r x *⇩C f)"
using ‹f ≠ 0›
by (simp add: inverse_eq_divide pos_le_divide_eq mult.commute)
qed
qed (simp add: onorm_zero)
subsection ‹Finite dimension and canonical basis›
lemma vector_finitely_spanned:
assumes ‹z ∈ cspan T›
shows ‹∃ S. finite S ∧ S ⊆ T ∧ z ∈ cspan S›
proof-
have ‹∃ S r. finite S ∧ S ⊆ T ∧ z = (∑a∈S. r a *⇩C a)›
using complex_vector.span_explicit[where b = "T"]
assms by auto
then obtain S r where ‹finite S› and ‹S ⊆ T› and ‹z = (∑a∈S. r a *⇩C a)›
by blast
thus ?thesis
by (meson complex_vector.span_scale complex_vector.span_sum complex_vector.span_superset subset_iff)
qed
setup ‹Sign.add_const_constraint ("Complex_Vector_Spaces0.cindependent", SOME \<^typ>‹'a set ⇒ bool›)›
setup ‹Sign.add_const_constraint (\<^const_name>‹cdependent›, SOME \<^typ>‹'a set ⇒ bool›)›
setup ‹Sign.add_const_constraint (\<^const_name>‹cspan›, SOME \<^typ>‹'a set ⇒ 'a set›)›
class cfinite_dim = complex_vector +
assumes cfinitely_spanned: "∃S::'a set. finite S ∧ cspan S = UNIV"
class basis_enum = complex_vector +
fixes canonical_basis :: "'a list"
assumes distinct_canonical_basis[simp]:
"distinct canonical_basis"
and is_cindependent_set[simp]:
"cindependent (set canonical_basis)"
and is_generator_set[simp]:
"cspan (set canonical_basis) = UNIV"
setup ‹Sign.add_const_constraint ("Complex_Vector_Spaces0.cindependent", SOME \<^typ>‹'a::complex_vector set ⇒ bool›)›
setup ‹Sign.add_const_constraint (\<^const_name>‹cdependent›, SOME \<^typ>‹'a::complex_vector set ⇒ bool›)›
setup ‹Sign.add_const_constraint (\<^const_name>‹cspan›, SOME \<^typ>‹'a::complex_vector set ⇒ 'a set›)›
lemma cdim_UNIV_basis_enum[simp]: ‹cdim (UNIV::'a::basis_enum set) = length (canonical_basis::'a list)›
apply (subst is_generator_set[symmetric])
apply (subst complex_vector.dim_span_eq_card_independent)
apply (rule is_cindependent_set)
using distinct_canonical_basis distinct_card by blast
lemma finite_basis: "∃basis::'a::cfinite_dim set. finite basis ∧ cindependent basis ∧ cspan basis = UNIV"
proof -
from cfinitely_spanned
obtain S :: ‹'a set› where ‹finite S› and ‹cspan S = UNIV›
by auto
from complex_vector.maximal_independent_subset
obtain B :: ‹'a set› where ‹B ⊆ S› and ‹cindependent B› and ‹S ⊆ cspan B›
by metis
moreover have ‹finite B›
using ‹B ⊆ S› ‹finite S›
by (meson finite_subset)
moreover have ‹cspan B = UNIV›
using ‹cspan S = UNIV› ‹S ⊆ cspan B›
by (metis complex_vector.span_eq top_greatest)
ultimately show ?thesis
by auto
qed
instance basis_enum ⊆ cfinite_dim
apply intro_classes
apply (rule exI[of _ ‹set canonical_basis›])
using is_cindependent_set is_generator_set by auto
lemma cindependent_cfinite_dim_finite:
assumes ‹cindependent (S::'a::cfinite_dim set)›
shows ‹finite S›
by (metis assms cfinitely_spanned complex_vector.independent_span_bound top_greatest)
lemma cfinite_dim_finite_subspace_basis:
assumes ‹csubspace X›
shows "∃basis::'a::cfinite_dim set. finite basis ∧ cindependent basis ∧ cspan basis = X"
by (meson assms cindependent_cfinite_dim_finite complex_vector.basis_exists complex_vector.span_subspace)
text ‹The following auxiliary lemma (‹finite_span_complete_aux›) shows more or less the same as ‹finite_span_representation_bounded›,
‹finite_span_complete› below (see there for an intuition about the mathematical
content of the lemmas). However, there is one difference: Here we additionally assume here
that there is a bijection rep/abs between a finite type \<^typ>‹'basis› and the set $B$.
This is needed to be able to use results about euclidean spaces that are formulated w.r.t.
the type class \<^class>‹finite›
Since we anyway assume that $B$ is finite, this added assumption does not make the lemma
weaker. However, we cannot derive the existence of \<^typ>‹'basis› inside the proof
(HOL does not support such reasoning). Therefore we have the type \<^typ>‹'basis› as
an explicit assumption and remove it using @{attribute internalize_sort} after the proof.›
lemma finite_span_complete_aux:
fixes b :: "'b::real_normed_vector" and B :: "'b set"
and rep :: "'basis::finite ⇒ 'b" and abs :: "'b ⇒ 'basis"
assumes t: "type_definition rep abs B"
and t1: "finite B" and t2: "b∈B" and t3: "independent B"
shows "∃D>0. ∀ψ. norm (representation B ψ b) ≤ norm ψ * D"
and "complete (span B)"
proof -
define repr where "repr = real_vector.representation B"
define repr' where "repr' ψ = Abs_euclidean_space (repr ψ o rep)" for ψ
define comb where "comb l = (∑b∈B. l b *⇩R b)" for l
define comb' where "comb' l = comb (Rep_euclidean_space l o abs)" for l
have comb_cong: "comb x = comb y" if "⋀z. z∈B ⟹ x z = y z" for x y
unfolding comb_def using that by auto
have comb_repr[simp]: "comb (repr ψ) = ψ" if "ψ ∈ real_vector.span B" for ψ
using ‹comb ≡ λl. ∑b∈B. l b *⇩R b› local.repr_def real_vector.sum_representation_eq t1 t3 that
by fastforce
have w5:"(∑b | (b ∈ B ⟶ x b ≠ 0) ∧ b ∈ B. x b *⇩R b) =
(∑b∈B. x b *⇩R b)" for x
using ‹finite B›
by (smt DiffD1 DiffD2 mem_Collect_eq real_vector.scale_eq_0_iff subset_eq sum.mono_neutral_left)
have "representation B (∑b∈B. x b *⇩R b) = (λb. if b ∈ B then x b else 0)"
for x
proof (rule real_vector.representation_eqI)
show "independent B"
by (simp add: t3)
show "(∑b∈B. x b *⇩R b) ∈ span B"
by (meson real_vector.span_scale real_vector.span_sum real_vector.span_superset subset_iff)
show "b ∈ B"
if "(if b ∈ B then x b else 0) ≠ 0"
for b :: 'b
using that
by meson
show "finite {b. (if b ∈ B then x b else 0) ≠ 0}"
using t1 by auto
show "(∑b | (if b ∈ B then x b else 0) ≠ 0. (if b ∈ B then x b else 0) *⇩R b) = (∑b∈B. x b *⇩R b)"
using w5
by simp
qed
hence repr_comb[simp]: "repr (comb x) = (λb. if b∈B then x b else 0)" for x
unfolding repr_def comb_def.
have repr_bad[simp]: "repr ψ = (λ_. 0)" if "ψ ∉ real_vector.span B" for ψ
unfolding repr_def using that
by (simp add: real_vector.representation_def)
have [simp]: "repr' ψ = 0" if "ψ ∉ real_vector.span B" for ψ
unfolding repr'_def repr_bad[OF that]
apply transfer
by auto
have comb'_repr'[simp]: "comb' (repr' ψ) = ψ"
if "ψ ∈ real_vector.span B" for ψ
proof -
have x1: "(repr ψ ∘ rep ∘ abs) z = repr ψ z"
if "z ∈ B"
for z
unfolding o_def
using t that type_definition.Abs_inverse by fastforce
have "comb' (repr' ψ) = comb ((repr ψ ∘ rep) ∘ abs)"
unfolding comb'_def repr'_def
by (subst Abs_euclidean_space_inverse; simp)
also have "… = comb (repr ψ)"
using x1 comb_cong by blast
also have "… = ψ"
using that by simp
finally show ?thesis by -
qed
have t1: "Abs_euclidean_space (Rep_euclidean_space t) = t"
if "⋀x. rep x ∈ B"
for t::"'a euclidean_space"
apply (subst Rep_euclidean_space_inverse)
by simp
have "Abs_euclidean_space
(λy. if rep y ∈ B
then Rep_euclidean_space x y
else 0) = x"
for x
using type_definition.Rep[OF t] apply simp
using t1 by blast
hence "Abs_euclidean_space
(λy. if rep y ∈ B
then Rep_euclidean_space x (abs (rep y))
else 0) = x"
for x
apply (subst type_definition.Rep_inverse[OF t])
by simp
hence repr'_comb'[simp]: "repr' (comb' x) = x" for x
unfolding comb'_def repr'_def o_def
by simp
have sphere: "compact (sphere 0 d :: 'basis euclidean_space set)" for d
using compact_sphere by blast
have "complete (UNIV :: 'basis euclidean_space set)"
by (simp add: complete_UNIV)
have "(∑b∈B. (Rep_euclidean_space (x + y) ∘ abs) b *⇩R b) = (∑b∈B. (Rep_euclidean_space x ∘ abs) b *⇩R b) + (∑b∈B. (Rep_euclidean_space y ∘ abs) b *⇩R b)"
for x :: "'basis euclidean_space"
and y :: "'basis euclidean_space"
apply (transfer fixing: abs)
by (simp add: scaleR_add_left sum.distrib)
moreover have "(∑b∈B. (Rep_euclidean_space (c *⇩R x) ∘ abs) b *⇩R b) = c *⇩R (∑b∈B. (Rep_euclidean_space x ∘ abs) b *⇩R b)"
for c :: real
and x :: "'basis euclidean_space"
apply (transfer fixing: abs)
by (simp add: real_vector.scale_sum_right)
ultimately have blin_comb': "bounded_linear comb'"
unfolding comb_def comb'_def
by (rule bounded_linearI')
hence "continuous_on X comb'" for X
by (simp add: linear_continuous_on)
hence "compact (comb' ` sphere 0 d)" for d
using sphere
by (rule compact_continuous_image)
hence compact_norm_comb': "compact (norm ` comb' ` sphere 0 1)"
using compact_continuous_image continuous_on_norm_id by blast
have not0: "0 ∉ norm ` comb' ` sphere 0 1"
proof (rule ccontr, simp)
assume "0 ∈ norm ` comb' ` sphere 0 1"
then obtain x where nc0: "norm (comb' x) = 0" and x: "x ∈ sphere 0 1"
by auto
hence "comb' x = 0"
by simp
hence "repr' (comb' x) = 0"
unfolding repr'_def o_def repr_def apply simp
by (smt repr'_comb' blin_comb' dist_0_norm linear_simps(3) mem_sphere norm_zero x)
hence "x = 0"
by auto
with x show False
by simp
qed
have "closed (norm ` comb' ` sphere 0 1)"
using compact_imp_closed compact_norm_comb' by blast
moreover have "0 ∉ norm ` comb' ` sphere 0 1"
by (simp add: not0)
ultimately have "∃d>0. ∀x∈norm ` comb' ` sphere 0 1. d ≤ dist 0 x"
by (meson separate_point_closed)
then obtain d where d: "x∈norm ` comb' ` sphere 0 1 ⟹ d ≤ dist 0 x"
and "d > 0" for x
by metis
define D where "D = 1/d"
hence "D > 0"
using ‹d>0› unfolding D_def by auto
have "x ≥ d"
if "x∈norm ` comb' ` sphere 0 1"
for x
using d that
apply auto
by fastforce
hence *: "norm (comb' x) ≥ d" if "norm x = 1" for x
using that by auto
have norm_comb': "norm (comb' x) ≥ d * norm x" for x
proof (cases "x=0")
show "d * norm x ≤ norm (comb' x)"
if "x = 0"
using that
by simp
show "d * norm x ≤ norm (comb' x)"
if "x ≠ 0"
using that
using *[of "(1/norm x) *⇩R x"]
unfolding linear_simps(5)[OF blin_comb']
apply auto
by (simp add: le_divide_eq)
qed
have *: "norm (repr' ψ) ≤ norm ψ * D" for ψ
proof (cases "ψ ∈ real_vector.span B")
show "norm (repr' ψ) ≤ norm ψ * D"
if "ψ ∈ span B"
using that unfolding D_def
using norm_comb'[of "repr' ψ"] ‹d>0›
by (simp_all add: linordered_field_class.mult_imp_le_div_pos mult.commute)
show "norm (repr' ψ) ≤ norm ψ * D"
if "ψ ∉ span B"
using that ‹0 < D› by auto
qed
hence "norm (Rep_euclidean_space (repr' ψ) (abs b)) ≤ norm ψ * D" for ψ
proof -
have "(Rep_euclidean_space (repr' ψ) (abs b)) = repr' ψ ∙ euclidean_space_basis_vector (abs b)"
apply (transfer fixing: abs b)
by auto
also have "¦…¦ ≤ norm (repr' ψ)"
apply (rule Basis_le_norm)
unfolding Basis_euclidean_space_def by simp
also have "… ≤ norm ψ * D"
using * by auto
finally show ?thesis by simp
qed
hence "norm (repr ψ b) ≤ norm ψ * D" for ψ
unfolding repr'_def
by (smt ‹comb' ≡ λl. comb (Rep_euclidean_space l ∘ abs)›
‹repr' ≡ λψ. Abs_euclidean_space (repr ψ ∘ rep)› comb'_repr' comp_apply norm_le_zero_iff
repr_bad repr_comb)
thus "∃D>0. ∀ψ. norm (repr ψ b) ≤ norm ψ * D"
using ‹D>0› by auto
from ‹d>0›
have complete_comb': "complete (comb' ` UNIV)"
proof (rule complete_isometric_image)
show "subspace (UNIV::'basis euclidean_space set)"
by simp
show "bounded_linear comb'"
by (simp add: blin_comb')
show "∀x∈UNIV. d * norm x ≤ norm (comb' x)"
by (simp add: norm_comb')
show "complete (UNIV::'basis euclidean_space set)"
by (simp add: ‹complete UNIV›)
qed
have range_comb': "comb' ` UNIV = real_vector.span B"
proof (auto simp: image_def)
show "comb' x ∈ real_vector.span B" for x
by (metis comb'_def comb_cong comb_repr local.repr_def repr_bad repr_comb real_vector.representation_zero real_vector.span_zero)
next
fix ψ assume "ψ ∈ real_vector.span B"
then obtain f where f: "comb f = ψ"
apply atomize_elim
unfolding span_finite[OF ‹finite B›] comb_def
by auto
define f' where "f' b = (if b∈B then f b else 0)" for b :: 'b
have f': "comb f' = ψ"
unfolding f[symmetric]
apply (rule comb_cong)
unfolding f'_def by simp
define x :: "'basis euclidean_space" where "x = Abs_euclidean_space (f' o rep)"
have "ψ = comb' x"
by (metis (no_types, lifting) ‹ψ ∈ span B› ‹repr' ≡ λψ. Abs_euclidean_space (repr ψ ∘ rep)›
comb'_repr' f' fun.map_cong repr_comb t type_definition.Rep_range x_def)
thus "∃x. ψ = comb' x"
by auto
qed
from range_comb' complete_comb'
show "complete (real_vector.span B)"
by simp
qed
lemma finite_span_complete[simp]:
fixes A :: "'a::real_normed_vector set"
assumes "finite A"
shows "complete (span A)"
text ‹The span of a finite set is complete.›
proof (cases "A ≠ {} ∧ A ≠ {0}")
case True
obtain B where
BT: "real_vector.span B = real_vector.span A"
and "independent B"
and "finite B"
by (meson True assms finite_subset real_vector.maximal_independent_subset real_vector.span_eq
real_vector.span_superset subset_trans)
have "B≠{}"
apply (rule ccontr, simp)
using BT True
by (metis real_vector.span_superset real_vector.span_empty subset_singletonD)
{
assume "∃(Rep :: 'basisT⇒'a) Abs. type_definition Rep Abs B"
then obtain rep :: "'basisT ⇒ 'a" and abs :: "'a ⇒ 'basisT" where t: "type_definition rep abs B"
by auto
have basisT_finite: "class.finite TYPE('basisT)"
apply intro_classes
using ‹finite B› t
by (metis (mono_tags, hide_lams) ex_new_if_finite finite_imageI image_eqI type_definition_def)
note finite_span_complete_aux(2)[internalize_sort "'basis::finite"]
note this[OF basisT_finite t]
}
note this[cancel_type_definition, OF ‹B≠{}› ‹finite B› _ ‹independent B›]
hence "complete (real_vector.span B)"
using ‹B≠{}› by auto
thus "complete (real_vector.span A)"
unfolding BT by simp
next
case False
thus ?thesis
using complete_singleton by auto
qed
lemma finite_span_representation_bounded:
fixes B :: "'a::real_normed_vector set"
assumes "finite B" and "independent B"
shows "∃D>0. ∀ψ b. abs (representation B ψ b) ≤ norm ψ * D"
text ‹
Assume $B$ is a finite linear independent set of vectors (in a real normed vector space).
Let $\alpha^\psi_b$ be the coefficients of $\psi$ expressed as a linear combination over $B$.
Then $\alpha$ is is uniformly cblinfun (i.e., $\lvert\alpha^\psi_b \leq D \lVert\psi\rVert\psi$
for some $D$ independent of $\psi,b$).
(This also holds when $b$ is not in the span of $B$ because of the way ‹real_vector.representation›
is defined in this corner case.)›
proof (cases "B≠{}")
case True
define repr where "repr = real_vector.representation B"
{
assume "∃(Rep :: 'basisT⇒'a) Abs. type_definition Rep Abs B"
then obtain rep :: "'basisT ⇒ 'a" and abs :: "'a ⇒ 'basisT" where t: "type_definition rep abs B"
by auto
have basisT_finite: "class.finite TYPE('basisT)"
apply intro_classes
using ‹finite B› t
by (metis (mono_tags, hide_lams) ex_new_if_finite finite_imageI image_eqI type_definition_def)
note finite_span_complete_aux(1)[internalize_sort "'basis::finite"]
note this[OF basisT_finite t]
}
note this[cancel_type_definition, OF True ‹finite B› _ ‹independent B›]
hence d2:"∃D. ∀ψ. D>0 ∧ norm (repr ψ b) ≤ norm ψ * D" if ‹b∈B› for b
by (simp add: repr_def that True)
have d1: " (⋀b. b ∈ B ⟹
∃D. ∀ψ. 0 < D ∧ norm (repr ψ b) ≤ norm ψ * D) ⟹
∃D. ∀b ψ. b ∈ B ⟶
0 < D b ∧ norm (repr ψ b) ≤ norm ψ * D b"
apply (rule choice) by auto
then obtain D where D: "D b > 0 ∧ norm (repr ψ b) ≤ norm ψ * D b" if "b∈B" for b ψ
apply atomize_elim
using d2 by blast
hence Dpos: "D b > 0" and Dbound: "norm (repr ψ b) ≤ norm ψ * D b"
if "b∈B" for b ψ
using that by auto
define Dall where "Dall = Max (D`B)"
have "Dall > 0"
unfolding Dall_def using ‹finite B› ‹B≠{}› Dpos
by (metis (mono_tags, lifting) Max_in finite_imageI image_iff image_is_empty)
have "Dall ≥ D b" if "b∈B" for b
unfolding Dall_def using ‹finite B› that by auto
with Dbound
have "norm (repr ψ b) ≤ norm ψ * Dall" if "b∈B" for b ψ
using that
by (smt mult_left_mono norm_not_less_zero)
moreover have "norm (repr ψ b) ≤ norm ψ * Dall" if "b∉B" for b ψ
unfolding repr_def using real_vector.representation_ne_zero True
by (metis calculation empty_subsetI less_le_trans local.repr_def norm_ge_zero norm_zero not_less
subsetI subset_antisym)
ultimately show "∃D>0. ∀ψ b. abs (repr ψ b) ≤ norm ψ * D"
using ‹Dall > 0› real_norm_def by metis
next
case False
thus ?thesis
unfolding repr_def using real_vector.representation_ne_zero[of B]
using nice_ordered_field_class.linordered_field_no_ub by fastforce
qed
hide_fact finite_span_complete_aux
lemma finite_cspan_complete[simp]:
fixes B :: "'a::complex_normed_vector set"
assumes "finite B"
shows "complete (cspan B)"
by (simp add: assms cspan_as_span)
lemma finite_span_closed[simp]:
fixes B :: "'a::real_normed_vector set"
assumes "finite B"
shows "closed (real_vector.span B)"
by (simp add: assms complete_imp_closed)
lemma finite_cspan_closed[simp]:
fixes S::‹'a::complex_normed_vector set›
assumes a1: ‹finite S›
shows ‹closed (cspan S)›
by (simp add: assms complete_imp_closed)
lemma closure_finite_cspan:
fixes T::‹'a::complex_normed_vector set›
assumes ‹finite T›
shows ‹closure (cspan T) = cspan T›
by (simp add: assms)
lemma finite_cspan_crepresentation_bounded:
fixes B :: "'a::complex_normed_vector set"
assumes a1: "finite B" and a2: "cindependent B"
shows "∃D>0. ∀ψ b. norm (crepresentation B ψ b) ≤ norm ψ * D"
proof -
define B' where "B' = (B ∪ scaleC 𝗂 ` B)"
have independent_B': "independent B'"
using B'_def ‹cindependent B›
by (simp add: real_independent_from_complex_independent a1)
have "finite B'"
unfolding B'_def using ‹finite B› by simp
obtain D' where "D' > 0" and D': "norm (real_vector.representation B' ψ b) ≤ norm ψ * D'"
for ψ b
apply atomize_elim
using independent_B' ‹finite B'›
by (simp add: finite_span_representation_bounded)
define D where "D = 2*D'"
from ‹D' > 0› have ‹D > 0›
unfolding D_def by simp
have "norm (crepresentation B ψ b) ≤ norm ψ * D" for ψ b
proof (cases "b∈B")
case True
have d3: "norm 𝗂 = 1"
by simp
have "norm (𝗂 *⇩C complex_of_real (real_vector.representation B' ψ (𝗂 *⇩C b)))
= norm 𝗂 * norm (complex_of_real (real_vector.representation B' ψ (𝗂 *⇩C b)))"
using norm_scaleC by blast
also have "… = norm (complex_of_real (real_vector.representation B' ψ (𝗂 *⇩C b)))"
using d3 by simp
finally have d2:"norm (𝗂 *⇩C complex_of_real (real_vector.representation B' ψ (𝗂 *⇩C b)))
= norm (complex_of_real (real_vector.representation B' ψ (𝗂 *⇩C b)))".
have "norm (crepresentation B ψ b)
= norm (complex_of_real (real_vector.representation B' ψ b)
+ 𝗂 *⇩C complex_of_real (real_vector.representation B' ψ (𝗂 *⇩C b)))"
by (simp add: B'_def True a1 a2 crepresentation_from_representation)
also have "… ≤ norm (complex_of_real (real_vector.representation B' ψ b))
+ norm (𝗂 *⇩C complex_of_real (real_vector.representation B' ψ (𝗂 *⇩C b)))"
using norm_triangle_ineq by blast
also have "… = norm (complex_of_real (real_vector.representation B' ψ b))
+ norm (complex_of_real (real_vector.representation B' ψ (𝗂 *⇩C b)))"
using d2 by simp
also have "… = norm (real_vector.representation B' ψ b)
+ norm (real_vector.representation B' ψ (𝗂 *⇩C b))"
by simp
also have "… ≤ norm ψ * D' + norm ψ * D'"
by (rule add_mono; rule D')
also have "… ≤ norm ψ * D"
unfolding D_def by linarith
finally show ?thesis
by auto
next
case False
hence "crepresentation B ψ b = 0"
using complex_vector.representation_ne_zero by blast
thus ?thesis
by (smt ‹0 < D› norm_ge_zero norm_zero split_mult_pos_le)
qed
with ‹D > 0›
show ?thesis
by auto
qed
lemma bounded_clinear_finite_dim[simp]:
fixes f :: ‹'a::{cfinite_dim,complex_normed_vector} ⇒ 'b::complex_normed_vector›
assumes ‹clinear f›
shows ‹bounded_clinear f›
proof -
include notation_norm
obtain basis :: ‹'a set› where b1: "complex_vector.span basis = UNIV"
and b2: "cindependent basis"
and b3:"finite basis"
using finite_basis by auto
have "∃C>0. ∀ψ b. cmod (crepresentation basis ψ b) ≤ ∥ψ∥ * C"
using finite_cspan_crepresentation_bounded[where B = basis] b2 b3 by blast
then obtain C where s1: "cmod (crepresentation basis ψ b) ≤ ∥ψ∥ * C"
and s2: "C > 0"
for ψ b by blast
define M where "M = C * (∑a∈basis. ∥f a∥)"
have "∥f x∥ ≤ ∥x∥ * M"
for x
proof-
define r where "r b = crepresentation basis x b" for b
have x_span: "x ∈ complex_vector.span basis"
by (simp add: b1)
have f0: "v ∈ basis"
if "r v ≠ 0" for v
using complex_vector.representation_ne_zero r_def that by auto
have w:"{a|a. r a ≠ 0} ⊆ basis"
using f0 by blast
hence f1: "finite {a|a. r a ≠ 0}"
using b3 rev_finite_subset by auto
have f2: "(∑a| r a ≠ 0. r a *⇩C a) = x"
unfolding r_def
using b2 complex_vector.sum_nonzero_representation_eq x_span
Collect_cong by fastforce
have g1: "(∑a∈basis. crepresentation basis x a *⇩C a) = x"
by (simp add: b2 b3 complex_vector.sum_representation_eq x_span)
have f3: "(∑a∈basis. r a *⇩C a) = x"
unfolding r_def
by (simp add: g1)
hence "f x = f (∑a∈basis. r a *⇩C a)"
by simp
also have "… = (∑a∈basis. r a *⇩C f a)"
by (smt (verit, ccfv_SIG) assms complex_vector.linear_scale complex_vector.linear_sum sum.cong)
finally have "f x = (∑a∈basis. r a *⇩C f a)".
hence "∥f x∥ = ∥(∑a∈basis. r a *⇩C f a)∥"
by simp
also have "… ≤ (∑a∈basis. ∥r a *⇩C f a∥)"
by (simp add: sum_norm_le)
also have "… ≤ (∑a∈basis. ∥r a∥ * ∥f a∥)"
by simp
also have "… ≤ (∑a∈basis. ∥x∥ * C * ∥f a∥)"
using sum_mono s1 unfolding r_def
by (simp add: sum_mono mult_right_mono)
also have "… ≤ ∥x∥ * C * (∑a∈basis. ∥f a∥)"
using sum_distrib_left
by (smt sum.cong)
also have "… = ∥x∥ * M"
unfolding M_def
by linarith
finally show ?thesis .
qed
thus ?thesis
using assms bounded_clinear_def bounded_clinear_axioms_def by blast
qed
subsection ‹Closed subspaces›
lemma csubspace_INF[simp]: "(⋀x. x ∈ A ⟹ csubspace x) ⟹ csubspace (⋂A)"
by (simp add: complex_vector.subspace_Inter)
locale closed_csubspace =
fixes A::"('a::{complex_vector,topological_space}) set"
assumes subspace: "csubspace A"
assumes closed: "closed A"
declare closed_csubspace.subspace[simp]
lemma closure_is_csubspace[simp]:
fixes A::"('a::complex_normed_vector) set"
assumes ‹csubspace A›
shows ‹csubspace (closure A)›
proof-
have "x ∈ closure A ⟹ y ∈ closure A ⟹ x+y ∈ closure A" for x y
proof-
assume ‹x∈(closure A)›
then obtain xx where ‹∀ n::nat. xx n ∈ A› and ‹xx ⇢ x›
using closure_sequential by blast
assume ‹y∈(closure A)›
then obtain yy where ‹∀ n::nat. yy n ∈ A› and ‹yy ⇢ y›
using closure_sequential by blast
have ‹∀ n::nat. (xx n) + (yy n) ∈ A›
using ‹∀n. xx n ∈ A› ‹∀n. yy n ∈ A› assms complex_vector.subspace_def
by (simp add: complex_vector.subspace_def)
hence ‹(λ n. (xx n) + (yy n)) ⇢ x + y› using ‹xx ⇢ x› ‹yy ⇢ y›
by (simp add: tendsto_add)
thus ?thesis using ‹∀ n::nat. (xx n) + (yy n) ∈ A›
by (meson closure_sequential)
qed
moreover have "x∈(closure A) ⟹ c *⇩C x ∈ (closure A)" for x c
proof-
assume ‹x∈(closure A)›
then obtain xx where ‹∀ n::nat. xx n ∈ A› and ‹xx ⇢ x›
using closure_sequential by blast
have ‹∀ n::nat. c *⇩C (xx n) ∈ A›
using ‹∀n. xx n ∈ A› assms complex_vector.subspace_def
by (simp add: complex_vector.subspace_def)
have ‹isCont (λ t. c *⇩C t) x›
using bounded_clinear.bounded_linear bounded_clinear_scaleC_right linear_continuous_at by auto
hence ‹(λ n. c *⇩C (xx n)) ⇢ c *⇩C x› using ‹xx ⇢ x›
by (simp add: isCont_tendsto_compose)
thus ?thesis using ‹∀ n::nat. c *⇩C (xx n) ∈ A›
by (meson closure_sequential)
qed
moreover have "0 ∈ (closure A)"
using assms closure_subset complex_vector.subspace_def
by (metis in_mono)
ultimately show ?thesis
by (simp add: complex_vector.subspaceI)
qed
lemma csubspace_set_plus:
assumes ‹csubspace A› and ‹csubspace B›
shows ‹csubspace (A + B)›
proof -
define C where ‹C = {ψ+φ| ψ φ. ψ∈A ∧ φ∈B}›
have "x∈C ⟹ y∈C ⟹ x+y∈C" for x y
using C_def assms(1) assms(2) complex_vector.subspace_add complex_vector.subspace_sums by blast
moreover have "c *⇩C x ∈ C" if ‹x∈C› for x c
proof -
have "csubspace C"
by (simp add: C_def assms(1) assms(2) complex_vector.subspace_sums)
then show ?thesis
using that by (simp add: complex_vector.subspace_def)
qed
moreover have "0 ∈ C"
using ‹C = {ψ + φ |ψ φ. ψ ∈ A ∧ φ ∈ B}› add.inverse_neutral add_uminus_conv_diff assms(1) assms(2) diff_0 mem_Collect_eq
add.right_inverse
by (metis (mono_tags, lifting) complex_vector.subspace_0)
ultimately show ?thesis
unfolding C_def complex_vector.subspace_def
by (smt mem_Collect_eq set_plus_elim set_plus_intro)
qed
lemma closed_csubspace_0[simp]:
"closed_csubspace ({0} :: ('a::{complex_vector,t1_space}) set)"
proof-
have ‹csubspace {0}›
using add.right_neutral complex_vector.subspace_def scaleC_right.zero
by blast
moreover have "closed ({0} :: 'a set)"
by simp
ultimately show ?thesis
by (simp add: closed_csubspace_def)
qed
lemma closed_csubspace_UNIV[simp]: "closed_csubspace (UNIV::('a::{complex_vector,topological_space}) set)"
proof-
have ‹csubspace UNIV›
by simp
moreover have ‹closed UNIV›
by simp
ultimately show ?thesis
unfolding closed_csubspace_def by auto
qed
lemma closed_csubspace_inter[simp]:
assumes "closed_csubspace A" and "closed_csubspace B"
shows "closed_csubspace (A∩B)"
proof-
obtain C where ‹C = A ∩ B› by blast
have ‹csubspace C›
proof-
have "x∈C ⟹ y∈C ⟹ x+y∈C" for x y
by (metis IntD1 IntD2 IntI ‹C = A ∩ B› assms(1) assms(2) complex_vector.subspace_def closed_csubspace_def)
moreover have "x∈C ⟹ c *⇩C x ∈ C" for x c
by (metis IntD1 IntD2 IntI ‹C = A ∩ B› assms(1) assms(2) complex_vector.subspace_def closed_csubspace_def)
moreover have "0 ∈ C"
using ‹C = A ∩ B› assms(1) assms(2) complex_vector.subspace_def closed_csubspace_def by fastforce
ultimately show ?thesis
by (simp add: complex_vector.subspace_def)
qed
moreover have ‹closed C›
using ‹C = A ∩ B›
by (simp add: assms(1) assms(2) closed_Int closed_csubspace.closed)
ultimately show ?thesis
using ‹C = A ∩ B›
by (simp add: closed_csubspace_def)
qed
lemma closed_csubspace_INF[simp]:
assumes a1: "∀A∈𝒜. closed_csubspace A"
shows "closed_csubspace (⋂𝒜)"
proof-
have ‹csubspace (⋂𝒜)›
by (simp add: assms closed_csubspace.subspace complex_vector.subspace_Inter)
moreover have ‹closed (⋂𝒜)›
by (simp add: assms closed_Inter closed_csubspace.closed)
ultimately show ?thesis
by (simp add: closed_csubspace.intro)
qed
typedef (overloaded) ('a::"{complex_vector,topological_space}")
ccsubspace = ‹{S::'a set. closed_csubspace S}›
morphisms space_as_set Abs_clinear_space
using Complex_Vector_Spaces.closed_csubspace_UNIV by blast
setup_lifting type_definition_ccsubspace
lemma csubspace_space_as_set[simp]: ‹csubspace (space_as_set S)›
by (metis closed_csubspace_def mem_Collect_eq space_as_set)
instantiation ccsubspace :: (complex_normed_vector) scaleC begin
lift_definition scaleC_ccsubspace :: "complex ⇒ 'a ccsubspace ⇒ 'a ccsubspace" is
"λc S. (*⇩C) c ` S"
proof
show "csubspace ((*⇩C) c ` S)"
if "closed_csubspace S"
for c :: complex
and S :: "'a set"
using that
by (simp add: closed_csubspace.subspace complex_vector.linear_subspace_image)
show "closed ((*⇩C) c ` S)"
if "closed_csubspace S"
for c :: complex
and S :: "'a set"
using that
by (simp add: closed_scaleC closed_csubspace.closed)
qed
lift_definition scaleR_ccsubspace :: "real ⇒ 'a ccsubspace ⇒ 'a ccsubspace" is
"λc S. (*⇩R) c ` S"
proof
show "csubspace ((*⇩R) r ` S)"
if "closed_csubspace S"
for r :: real
and S :: "'a set"
using that using bounded_clinear_def bounded_clinear_scaleC_right scaleR_scaleC
by (simp add: scaleR_scaleC closed_csubspace.subspace complex_vector.linear_subspace_image)
show "closed ((*⇩R) r ` S)"
if "closed_csubspace S"
for r :: real
and S :: "'a set"
using that
by (simp add: closed_scaling closed_csubspace.closed)
qed
instance
proof
show "((*⇩R) r::'a ccsubspace ⇒ _) = (*⇩C) (complex_of_real r)" for r :: real
by (simp add: scaleR_scaleC scaleC_ccsubspace_def scaleR_ccsubspace_def)
qed
end
instantiation ccsubspace :: ("{complex_vector,t1_space}") bot begin
lift_definition bot_ccsubspace :: ‹'a ccsubspace› is ‹{0}›
by simp
instance..
end
lemma zero_cblinfun_image[simp]: "0 *⇩C S = bot" for S :: "_ ccsubspace"
proof transfer
have "(0::'b) ∈ (λx. 0) ` S"
if "closed_csubspace S"
for S::"'b set"
using that unfolding closed_csubspace_def
by (simp add: complex_vector.linear_subspace_image complex_vector.module_hom_zero
complex_vector.subspace_0)
thus "(*⇩C) 0 ` S = {0::'b}"
if "closed_csubspace (S::'b set)"
for S :: "'b set"
using that
by (auto intro !: exI [of _ 0])
qed
lemma csubspace_scaleC_invariant:
fixes a S
assumes ‹a ≠ 0› and ‹csubspace S›
shows ‹(*⇩C) a ` S = S›
proof-
have ‹x ∈ (*⇩C) a ` S ⟹ x ∈ S›
for x
using assms(2) complex_vector.subspace_scale by blast
moreover have ‹x ∈ S ⟹ x ∈ (*⇩C) a ` S›
for x
proof -
assume "x ∈ S"
hence "∃c aa. (c / a) *⇩C aa ∈ S ∧ c *⇩C aa = x"
using assms(2) complex_vector.subspace_def scaleC_one by metis
hence "∃aa. aa ∈ S ∧ a *⇩C aa = x"
using assms(1) by auto
thus ?thesis
by (meson image_iff)
qed
ultimately show ?thesis by blast
qed
lemma ccsubspace_scaleC_invariant[simp]: "a ≠ 0 ⟹ a *⇩C S = S" for S :: "_ ccsubspace"
apply transfer
by (simp add: closed_csubspace.subspace csubspace_scaleC_invariant)
instantiation ccsubspace :: ("{complex_vector,topological_space}") "top"
begin
lift_definition top_ccsubspace :: ‹'a ccsubspace› is ‹UNIV›
by simp
instance ..
end
lemma ccsubspace_top_not_bot[simp]:
"(top::'a::{complex_vector,t1_space,not_singleton} ccsubspace) ≠ bot"
by (metis UNIV_not_singleton bot_ccsubspace.rep_eq top_ccsubspace.rep_eq)
lemma ccsubspace_bot_not_top[simp]:
"(bot::'a::{complex_vector,t1_space,not_singleton} ccsubspace) ≠ top"
using ccsubspace_top_not_bot by metis
instantiation ccsubspace :: ("{complex_vector,topological_space}") "Inf"
begin
lift_definition Inf_ccsubspace::‹'a ccsubspace set ⇒ 'a ccsubspace›
is ‹λ S. ⋂ S›
proof
fix S :: "'a set set"
assume closed: "closed_csubspace x" if ‹x ∈ S› for x
show "csubspace (⋂ S::'a set)"
by (simp add: closed closed_csubspace.subspace)
show "closed (⋂ S::'a set)"
by (simp add: closed closed_csubspace.closed)
qed
instance ..
end
lift_definition ccspan :: "'a::complex_normed_vector set ⇒ 'a ccsubspace"
is "λG. closure (cspan G)"
proof (rule closed_csubspace.intro)
fix S :: "'a set"
show "csubspace (closure (cspan S))"
by (simp add: closure_is_csubspace)
show "closed (closure (cspan S))"
by simp
qed
lemma ccspan_canonical_basis[simp]: "ccspan (set canonical_basis) = top"
using ccspan.rep_eq space_as_set_inject top_ccsubspace.rep_eq
closure_UNIV is_generator_set
by metis
lemma ccspan_Inf_def: ‹ccspan A = Inf {S. A ⊆ space_as_set S}›
for A::‹('a::cbanach) set›
proof-
have ‹x ∈ space_as_set (ccspan A)
⟹ x ∈ space_as_set (Inf {S. A ⊆ space_as_set S})›
for x::'a
proof-
assume ‹x ∈ space_as_set (ccspan A)›
hence "x ∈ closure (cspan A)"
by (simp add: ccspan.rep_eq)
hence ‹x ∈ closure (complex_vector.span A)›
unfolding ccspan_def
by simp
hence ‹∃ y::nat ⇒ 'a. (∀ n. y n ∈ (complex_vector.span A)) ∧ y ⇢ x›
by (simp add: closure_sequential)
then obtain y where ‹∀ n. y n ∈ (complex_vector.span A)› and ‹y ⇢ x›
by blast
have ‹y n ∈ ⋂ {S. (complex_vector.span A) ⊆ S ∧ closed_csubspace S}›
for n
using ‹∀ n. y n ∈ (complex_vector.span A)›
by auto
have ‹closed_csubspace S ⟹ closed S›
for S::‹'a set›
by (simp add: closed_csubspace.closed)
hence ‹closed ( ⋂ {S. (complex_vector.span A) ⊆ S ∧ closed_csubspace S})›
by simp
hence ‹x ∈ ⋂ {S. (complex_vector.span A) ⊆ S ∧ closed_csubspace S}› using ‹y ⇢ x›
using ‹⋀n. y n ∈ ⋂ {S. complex_vector.span A ⊆ S ∧ closed_csubspace S}› closed_sequentially
by blast
moreover have ‹{S. A ⊆ S ∧ closed_csubspace S} ⊆ {S. (complex_vector.span A) ⊆ S ∧ closed_csubspace S}›
using Collect_mono_iff
by (simp add: Collect_mono_iff closed_csubspace.subspace complex_vector.span_minimal)
ultimately have ‹x ∈ ⋂ {S. A ⊆ S ∧ closed_csubspace S}›
by blast
moreover have "(x::'a) ∈ ⋂ {x. A ⊆ x ∧ closed_csubspace x}"
if "(x::'a) ∈ ⋂ {S. A ⊆ S ∧ closed_csubspace S}"
for x :: 'a
and A :: "'a set"
using that
by simp
ultimately show ‹x ∈ space_as_set (Inf {S. A ⊆ space_as_set S})›
apply transfer.
qed
moreover have ‹x ∈ space_as_set (Inf {S. A ⊆ space_as_set S})
⟹ x ∈ space_as_set (ccspan A)›
for x::'a
proof-
assume ‹x ∈ space_as_set (Inf {S. A ⊆ space_as_set S})›
hence ‹x ∈ ⋂ {S. A ⊆ S ∧ closed_csubspace S}›
apply transfer
by blast
moreover have ‹{S. (complex_vector.span A) ⊆ S ∧ closed_csubspace S} ⊆ {S. A ⊆ S ∧ closed_csubspace S}›
using Collect_mono_iff complex_vector.span_superset by fastforce
ultimately have ‹x ∈ ⋂ {S. (complex_vector.span A) ⊆ S ∧ closed_csubspace S}›
by blast
thus ‹x ∈ space_as_set (ccspan A)›
by (metis (no_types, lifting) Inter_iff space_as_set closure_subset mem_Collect_eq ccspan.rep_eq)
qed
ultimately have ‹space_as_set (ccspan A) = space_as_set (Inf {S. A ⊆ space_as_set S})›
by blast
thus ?thesis
using space_as_set_inject by auto
qed
lemma cspan_singleton_scaleC[simp]: "(a::complex)≠0 ⟹ cspan { a *⇩C ψ } = cspan {ψ}"
for ψ::"'a::complex_vector"
by (smt complex_vector.dependent_single complex_vector.independent_insert
complex_vector.scale_eq_0_iff complex_vector.span_base complex_vector.span_redundant
complex_vector.span_scale doubleton_eq_iff insert_absorb insert_absorb2 insert_commute
singletonI)
lemma closure_is_closed_csubspace[simp]:
fixes S::‹'a::complex_normed_vector set›
assumes ‹csubspace S›
shows ‹closed_csubspace (closure S)›
proof-
fix x y :: 'a and c :: complex
have "x + y ∈ closure S"
if "x ∈ closure S"
and "y ∈ closure S"
proof-
have ‹∃ r. (∀ n::nat. r n ∈ S) ∧ r ⇢ x›
using closure_sequential that(1) by auto
then obtain r where ‹∀ n::nat. r n ∈ S› and ‹r ⇢ x›
by blast
have ‹∃ s. (∀ n::nat. s n ∈ S) ∧ s ⇢ y›
using closure_sequential that(2) by auto
then obtain s where ‹∀ n::nat. s n ∈ S› and ‹s ⇢ y›
by blast
have ‹∀ n::nat. r n + s n ∈ S›
using ‹∀n. r n ∈ S› ‹∀n. s n ∈ S› assms complex_vector.subspace_add by blast
moreover have ‹(λ n. r n + s n) ⇢ x + y›
by (simp add: ‹r ⇢ x› ‹s ⇢ y› tendsto_add)
ultimately show ?thesis
using assms that(1) that(2)
by (simp add: complex_vector.subspace_add)
qed
moreover have "c *⇩C x ∈ closure S"
if "x ∈ closure S"
proof-
have ‹∃ y. (∀ n::nat. y n ∈ S) ∧ y ⇢ x›
using Elementary_Topology.closure_sequential that by auto
then obtain y where ‹∀ n::nat. y n ∈ S› and ‹y ⇢ x›
by blast
have ‹isCont (scaleC c) x›
by simp
hence ‹(λ n. scaleC c (y n)) ⇢ scaleC c x›
using ‹y ⇢ x›
by (simp add: isCont_tendsto_compose)
from ‹∀ n::nat. y n ∈ S›
have ‹∀ n::nat. scaleC c (y n) ∈ S›
using assms complex_vector.subspace_scale by auto
thus ?thesis
using assms that
by (simp add: complex_vector.subspace_scale)
qed
moreover have "0 ∈ closure S"
by (simp add: assms complex_vector.subspace_0)
moreover have "closed (closure S)"
by auto
ultimately show ?thesis
by (simp add: assms closed_csubspace_def)
qed
lemma ccspan_singleton_scaleC[simp]: "(a::complex)≠0 ⟹ ccspan {a *⇩C ψ} = ccspan {ψ}"
apply transfer by simp
lemma clinear_continuous_at:
assumes ‹bounded_clinear f›
shows ‹isCont f x›
by (simp add: assms bounded_clinear.bounded_linear linear_continuous_at)
lemma clinear_continuous_within:
assumes ‹bounded_clinear f›
shows ‹continuous (at x within s) f›
by (simp add: assms bounded_clinear.bounded_linear linear_continuous_within)
lemma antilinear_continuous_at:
assumes ‹bounded_antilinear f›
shows ‹isCont f x›
by (simp add: assms bounded_antilinear.bounded_linear linear_continuous_at)
lemma antilinear_continuous_within:
assumes ‹bounded_antilinear f›
shows ‹continuous (at x within s) f›
by (simp add: assms bounded_antilinear.bounded_linear linear_continuous_within)
lemma bounded_clinear_eq_on:
fixes A B :: "'a::complex_normed_vector ⇒ 'b::complex_normed_vector"
assumes ‹bounded_clinear A› and ‹bounded_clinear B› and
eq: ‹⋀x. x ∈ G ⟹ A x = B x› and t: ‹t ∈ closure (cspan G)›
shows ‹A t = B t›
proof -
have eq': ‹A t = B t› if ‹t ∈ cspan G› for t
using _ _ that eq apply (rule complex_vector.linear_eq_on)
by (auto simp: assms bounded_clinear.clinear)
have ‹A t - B t = 0›
using _ _ t apply (rule continuous_constant_on_closure)
by (auto simp add: eq' assms(1) assms(2) clinear_continuous_at continuous_at_imp_continuous_on)
then show ?thesis
by auto
qed
instantiation ccsubspace :: ("{complex_vector,topological_space}") "order"
begin
lift_definition less_eq_ccsubspace :: ‹'a ccsubspace ⇒ 'a ccsubspace ⇒ bool›
is ‹(⊆)›.
declare less_eq_ccsubspace_def[code del]
lift_definition less_ccsubspace :: ‹'a ccsubspace ⇒ 'a ccsubspace ⇒ bool›
is ‹(⊂)›.
declare less_ccsubspace_def[code del]
instance
proof
fix x y z :: "'a ccsubspace"
show "(x < y) = (x ≤ y ∧ ¬ y ≤ x)"
by (simp add: less_eq_ccsubspace.rep_eq less_le_not_le less_ccsubspace.rep_eq)
show "x ≤ x"
by (simp add: less_eq_ccsubspace.rep_eq)
show "x ≤ z" if "x ≤ y" and "y ≤ z"
using that less_eq_ccsubspace.rep_eq by auto
show "x = y" if "x ≤ y" and "y ≤ x"
using that by (simp add: space_as_set_inject less_eq_ccsubspace.rep_eq)
qed
end
lemma ccspan_leqI:
assumes ‹M ⊆ space_as_set S›
shows ‹ccspan M ≤ S›
using assms apply transfer
by (simp add: closed_csubspace.closed closure_minimal complex_vector.span_minimal)
lemma ccspan_mono:
assumes ‹A ⊆ B›
shows ‹ccspan A ≤ ccspan B›
apply (transfer fixing: A B)
by (simp add: assms closure_mono complex_vector.span_mono)
lemma bounded_sesquilinear_add:
‹bounded_sesquilinear (λ x y. A x y + B x y)› if ‹bounded_sesquilinear A› and ‹bounded_sesquilinear B›
proof
fix a a' :: 'a and b b' :: 'b and r :: complex
show "A (a + a') b + B (a + a') b = (A a b + B a b) + (A a' b + B a' b)"
by (simp add: bounded_sesquilinear.add_left that(1) that(2))
show ‹A a (b + b') + B a (b + b') = (A a b + B a b) + (A a b' + B a b')›
by (simp add: bounded_sesquilinear.add_right that(1) that(2))
show ‹A (r *⇩C a) b + B (r *⇩C a) b = cnj r *⇩C (A a b + B a b)›
by (simp add: bounded_sesquilinear.scaleC_left scaleC_add_right that(1) that(2))
show ‹A a (r *⇩C b) + B a (r *⇩C b) = r *⇩C (A a b + B a b)›
by (simp add: bounded_sesquilinear.scaleC_right scaleC_add_right that(1) that(2))
show ‹∃K. ∀a b. norm (A a b + B a b) ≤ norm a * norm b * K›
proof-
have ‹∃ KA. ∀ a b. norm (A a b) ≤ norm a * norm b * KA›
by (simp add: bounded_sesquilinear.bounded that(1))
then obtain KA where ‹∀ a b. norm (A a b) ≤ norm a * norm b * KA›
by blast
have ‹∃ KB. ∀ a b. norm (B a b) ≤ norm a * norm b * KB›
by (simp add: bounded_sesquilinear.bounded that(2))
then obtain KB where ‹∀ a b. norm (B a b) ≤ norm a * norm b * KB›
by blast
have ‹norm (A a b + B a b) ≤ norm a * norm b * (KA + KB)›
for a b
proof-
have ‹norm (A a b + B a b) ≤ norm (A a b) + norm (B a b)›
using norm_triangle_ineq by blast
also have ‹… ≤ norm a * norm b * KA + norm a * norm b * KB›
using ‹∀ a b. norm (A a b) ≤ norm a * norm b * KA›
‹∀ a b. norm (B a b) ≤ norm a * norm b * KB›
using add_mono by blast
also have ‹…= norm a * norm b * (KA + KB)›
by (simp add: mult.commute ring_class.ring_distribs(2))
finally show ?thesis
by blast
qed
thus ?thesis by blast
qed
qed
lemma bounded_sesquilinear_uminus:
‹bounded_sesquilinear (λ x y. - A x y)› if ‹bounded_sesquilinear A›
proof
fix a a' :: 'a and b b' :: 'b and r :: complex
show "- A (a + a') b = (- A a b) + (- A a' b)"
by (simp add: bounded_sesquilinear.add_left that)
show ‹- A a (b + b') = (- A a b) + (- A a b')›
by (simp add: bounded_sesquilinear.add_right that)
show ‹- A (r *⇩C a) b = cnj r *⇩C (- A a b)›
by (simp add: bounded_sesquilinear.scaleC_left that)
show ‹- A a (r *⇩C b) = r *⇩C (- A a b)›
by (simp add: bounded_sesquilinear.scaleC_right that)
show ‹∃K. ∀a b. norm (- A a b) ≤ norm a * norm b * K›
proof-
have ‹∃ KA. ∀ a b. norm (A a b) ≤ norm a * norm b * KA›
by (simp add: bounded_sesquilinear.bounded that(1))
then obtain KA where ‹∀ a b. norm (A a b) ≤ norm a * norm b * KA›
by blast
have ‹norm (- A a b) ≤ norm a * norm b * KA›
for a b
by (simp add: ‹∀a b. norm (A a b) ≤ norm a * norm b * KA›)
thus ?thesis by blast
qed
qed
lemma bounded_sesquilinear_diff:
‹bounded_sesquilinear (λ x y. A x y - B x y)› if ‹bounded_sesquilinear A› and ‹bounded_sesquilinear B›
proof -
have ‹bounded_sesquilinear (λ x y. - B x y)›
using that(2) by (rule bounded_sesquilinear_uminus)
then have ‹bounded_sesquilinear (λ x y. A x y + (- B x y))›
using that(1) by (rule bounded_sesquilinear_add[rotated])
then show ?thesis
by auto
qed
lemma ccsubspace_leI:
assumes t1: "space_as_set A ⊆ space_as_set B"
shows "A ≤ B"
using t1 apply transfer by -
lemma ccspan_of_empty[simp]: "ccspan {} = bot"
proof transfer
show "closure (cspan {}) = {0::'a}"
by simp
qed
instantiation ccsubspace :: ("{complex_vector,topological_space}") inf begin
lift_definition inf_ccsubspace :: "'a ccsubspace ⇒ 'a ccsubspace ⇒ 'a ccsubspace"
is "(∩)" by simp
instance .. end
lemma space_as_set_inf[simp]: "space_as_set (A ⊓ B) = space_as_set A ∩ space_as_set B"
by (rule inf_ccsubspace.rep_eq)
instantiation ccsubspace :: ("{complex_vector,topological_space}") order_top begin
instance
proof
show "a ≤ ⊤"
for a :: "'a ccsubspace"
apply transfer
by simp
qed
end
instantiation ccsubspace :: ("{complex_vector,t1_space}") order_bot begin
instance
proof
show "(⊥::'a ccsubspace) ≤ a"
for a :: "'a ccsubspace"
apply transfer
apply auto
using closed_csubspace.subspace complex_vector.subspace_0 by blast
qed
end
instantiation ccsubspace :: ("{complex_vector,topological_space}") semilattice_inf begin
instance
proof
fix x y z :: ‹'a ccsubspace›
show "x ⊓ y ≤ x"
apply transfer by simp
show "x ⊓ y ≤ y"
apply transfer by simp
show "x ≤ y ⊓ z" if "x ≤ y" and "x ≤ z"
using that apply transfer by simp
qed
end
instantiation ccsubspace :: ("{complex_vector,t1_space}") zero begin
definition zero_ccsubspace :: "'a ccsubspace" where [simp]: "zero_ccsubspace = bot"
lemma zero_ccsubspace_transfer[transfer_rule]: ‹pcr_ccsubspace (=) {0} 0›
unfolding zero_ccsubspace_def by transfer_prover
instance ..
end
subsection ‹Closed sums›
definition closed_sum:: ‹'a::{semigroup_add,topological_space} set ⇒ 'a set ⇒ 'a set› where
‹closed_sum A B = closure (A + B)›
notation closed_sum (infixl "+⇩M" 65)
lemma closed_sum_comm: ‹A +⇩M B = B +⇩M A› for A B :: "_::ab_semigroup_add"
by (simp add: add.commute closed_sum_def)
lemma closed_sum_left_subset: ‹0 ∈ B ⟹ A ⊆ A +⇩M B› for A B :: "_::monoid_add"
by (metis add.right_neutral closed_sum_def closure_subset in_mono set_plus_intro subsetI)
lemma closed_sum_right_subset: ‹0 ∈ A ⟹ B ⊆ A +⇩M B› for A B :: "_::monoid_add"
by (metis add.left_neutral closed_sum_def closure_subset set_plus_intro subset_iff)
lemma finite_cspan_closed_csubspace:
assumes "finite (S::'a::complex_normed_vector set)"
shows "closed_csubspace (cspan S)"
by (simp add: assms closed_csubspace.intro)
lemma closed_sum_is_sup:
fixes A B C:: ‹('a::{complex_vector,topological_space}) set›
assumes ‹closed_csubspace C›
assumes ‹A ⊆ C› and ‹B ⊆ C›
shows ‹(A +⇩M B) ⊆ C›
proof -
have ‹A + B ⊆ C›
using assms unfolding set_plus_def
using closed_csubspace.subspace complex_vector.subspace_add by blast
then show ‹(A +⇩M B) ⊆ C›
unfolding closed_sum_def
using ‹closed_csubspace C›
by (simp add: closed_csubspace.closed closure_minimal)
qed
lemma closed_subspace_closed_sum:
fixes A B::"('a::complex_normed_vector) set"
assumes a1: ‹csubspace A› and a2: ‹csubspace B›
shows ‹closed_csubspace (A +⇩M B)›
using a1 a2 closed_sum_def
by (metis closure_is_closed_csubspace csubspace_set_plus)
lemma closed_sum_assoc:
fixes A B C::"'a::real_normed_vector set"
shows ‹A +⇩M (B +⇩M C) = (A +⇩M B) +⇩M C›
proof -
have ‹A + closure B ⊆ closure (A + B)› for A B :: "'a set"
by (meson closure_subset closure_sum dual_order.trans order_refl set_plus_mono2)
then have ‹A +⇩M (B +⇩M C) = closure (A + (B + C))›
unfolding closed_sum_def
by (meson antisym_conv closed_closure closure_minimal closure_mono closure_subset equalityD1 set_plus_mono2)
moreover
have ‹closure A + B ⊆ closure (A + B)› for A B :: "'a set"
by (meson closure_subset closure_sum dual_order.trans order_refl set_plus_mono2)
then have ‹(A +⇩M B) +⇩M C = closure ((A + B) + C)›
unfolding closed_sum_def
by (meson closed_closure closure_minimal closure_mono closure_subset eq_iff set_plus_mono2)
ultimately show ?thesis
by (simp add: ab_semigroup_add_class.add_ac(1))
qed
lemma closed_sum_zero_left[simp]:
fixes A :: ‹('a::{monoid_add, topological_space}) set›
shows ‹{0} +⇩M A = closure A›
unfolding closed_sum_def
by (metis add.left_neutral set_zero)
lemma closed_sum_zero_right[simp]:
fixes A :: ‹('a::{monoid_add, topological_space}) set›
shows ‹A +⇩M {0} = closure A›
unfolding closed_sum_def
by (metis add.right_neutral set_zero)
lemma closed_sum_closure_right[simp]:
fixes A B :: ‹'a::real_normed_vector set›
shows ‹A +⇩M closure B = A +⇩M B›
by (metis closed_sum_assoc closed_sum_def closed_sum_zero_right closure_closure)
lemma closed_sum_closure_left[simp]:
fixes A B :: ‹'a::real_normed_vector set›
shows ‹closure A +⇩M B = A +⇩M B›
by (simp add: closed_sum_comm)
lemma closed_sum_mono_left:
assumes ‹A ⊆ B›
shows ‹A +⇩M C ⊆ B +⇩M C›
by (simp add: assms closed_sum_def closure_mono set_plus_mono2)
lemma closed_sum_mono_right:
assumes ‹A ⊆ B›
shows ‹C +⇩M A ⊆ C +⇩M B›
by (simp add: assms closed_sum_def closure_mono set_plus_mono2)
instantiation ccsubspace :: (complex_normed_vector) sup begin
lift_definition sup_ccsubspace :: "'a ccsubspace ⇒ 'a ccsubspace ⇒ 'a ccsubspace"
is "λA B::'a set. A +⇩M B"
by (simp add: closed_subspace_closed_sum)
instance ..
end
lemma closed_sum_cspan[simp]:
shows ‹cspan X +⇩M cspan Y = closure (cspan (X ∪ Y))›
by (smt (verit, best) Collect_cong closed_sum_def complex_vector.span_Un set_plus_def)
lemma closure_image_closed_sum:
assumes ‹bounded_linear U›
shows ‹closure (U ` (A +⇩M B)) = closure (U ` A) +⇩M closure (U ` B)›
proof -
have ‹closure (U ` (A +⇩M B)) = closure (U ` closure (closure A + closure B))›
unfolding closed_sum_def
by (smt (verit, best) closed_closure closure_minimal closure_mono closure_subset closure_sum set_plus_mono2 subset_antisym)
also have ‹… = closure (U ` (closure A + closure B))›
using assms closure_bounded_linear_image_subset_eq by blast
also have ‹… = closure (U ` closure A + U ` closure B)›
apply (subst image_set_plus)
by (simp_all add: assms bounded_linear.linear)
also have ‹… = closure (closure (U ` A) + closure (U ` B))›
by (smt (verit, ccfv_SIG) assms closed_closure closure_bounded_linear_image_subset closure_bounded_linear_image_subset_eq closure_minimal closure_mono closure_sum dual_order.eq_iff set_plus_mono2)
also have ‹… = closure (U ` A) +⇩M closure (U ` B)›
using closed_sum_def by blast
finally show ?thesis
by -
qed
lemma ccspan_union: "ccspan A ⊔ ccspan B = ccspan (A ∪ B)"
apply transfer by simp
instantiation ccsubspace :: (complex_normed_vector) "Sup"
begin
lift_definition Sup_ccsubspace::‹'a ccsubspace set ⇒ 'a ccsubspace›
is ‹λS. closure (complex_vector.span (Union S))›
proof
show "csubspace (closure (complex_vector.span (⋃ S::'a set)))"
if "⋀x::'a set. x ∈ S ⟹ closed_csubspace x"
for S :: "'a set set"
using that
by (simp add: closure_is_closed_csubspace)
show "closed (closure (complex_vector.span (⋃ S::'a set)))"
if "⋀x. (x::'a set) ∈ S ⟹ closed_csubspace x"
for S :: "'a set set"
using that
by simp
qed
instance..
end
instance ccsubspace :: ("{complex_normed_vector}") semilattice_sup
proof
fix x y z :: ‹'a ccsubspace›
show ‹x ≤ sup x y›
apply transfer
by (simp add: closed_csubspace_def closed_sum_left_subset complex_vector.subspace_0)
show "y ≤ sup x y"
apply transfer
by (simp add: closed_csubspace_def closed_sum_right_subset complex_vector.subspace_0)
show "sup x y ≤ z" if "x ≤ z" and "y ≤ z"
using that apply transfer
apply (rule closed_sum_is_sup) by auto
qed
instance ccsubspace :: ("{complex_normed_vector}") complete_lattice
proof
show "Inf A ≤ x"
if "x ∈ A"
for x :: "'a ccsubspace"
and A :: "'a ccsubspace set"
using that
apply transfer
by auto
have b1: "z ⊆ ⋂ A"
if "Ball A closed_csubspace" and
"closed_csubspace z" and
"(⋀x. closed_csubspace x ⟹ x ∈ A ⟹ z ⊆ x)"
for z::"'a set" and A
using that
by auto
show "z ≤ Inf A"
if "⋀x::'a ccsubspace. x ∈ A ⟹ z ≤ x"
for A :: "'a ccsubspace set"
and z :: "'a ccsubspace"
using that
apply transfer
using b1 by blast
show "x ≤ Sup A"
if "x ∈ A"
for x :: "'a ccsubspace"
and A :: "'a ccsubspace set"
using that
apply transfer
by (meson Union_upper closure_subset complex_vector.span_superset dual_order.trans)
show "Sup A ≤ z"
if "⋀x::'a ccsubspace. x ∈ A ⟹ x ≤ z"
for A :: "'a ccsubspace set"
and z :: "'a ccsubspace"
using that apply transfer
proof -
fix A :: "'a set set" and z :: "'a set"
assume A_closed: "Ball A closed_csubspace"
assume "closed_csubspace z"
assume in_z: "⋀x. closed_csubspace x ⟹ x ∈ A ⟹ x ⊆ z"
from A_closed in_z
have ‹V ⊆ z› if ‹V ∈ A› for V
by (simp add: that)
then have ‹⋃ A ⊆ z›
by (simp add: Sup_le_iff)
with ‹closed_csubspace z›
show "closure (cspan (⋃ A)) ⊆ z"
by (simp add: closed_csubspace_def closure_minimal complex_vector.span_def subset_hull)
qed
show "Inf {} = (top::'a ccsubspace)"
using ‹⋀z A. (⋀x. x ∈ A ⟹ z ≤ x) ⟹ z ≤ Inf A› top.extremum_uniqueI by auto
show "Sup {} = (bot::'a ccsubspace)"
using ‹⋀z A. (⋀x. x ∈ A ⟹ x ≤ z) ⟹ Sup A ≤ z› bot.extremum_uniqueI by auto
qed
instantiation ccsubspace :: (complex_normed_vector) comm_monoid_add begin
definition plus_ccsubspace :: "'a ccsubspace ⇒ _ ⇒ _"
where [simp]: "plus_ccsubspace = sup"
instance
proof
fix a b c :: ‹'a ccsubspace›
show "a + b + c = a + (b + c)"
using sup.assoc by auto
show "a + b = b + a"
by (simp add: sup.commute)
show "0 + a = a"
by (simp add: zero_ccsubspace_def)
qed
end
lemma ccsubspace_plus_sup: "y ≤ x ⟹ z ≤ x ⟹ y + z ≤ x"
for x y z :: "'a::complex_normed_vector ccsubspace"
unfolding plus_ccsubspace_def by auto
lemma ccsubspace_Sup_empty: "Sup {} = (0::_ ccsubspace)"
unfolding zero_ccsubspace_def by auto
lemma ccsubspace_add_right_incr[simp]: "a ≤ a + c" for a::"_ ccsubspace"
by (simp add: add_increasing2)
lemma ccsubspace_add_left_incr[simp]: "a ≤ c + a" for a::"_ ccsubspace"
by (simp add: add_increasing)
subsection ‹Conjugate space›
typedef 'a conjugate_space = "UNIV :: 'a set"
morphisms from_conjugate_space to_conjugate_space ..
setup_lifting type_definition_conjugate_space
instantiation conjugate_space :: (complex_vector) complex_vector begin
lift_definition scaleC_conjugate_space :: ‹complex ⇒ 'a conjugate_space ⇒ 'a conjugate_space› is ‹λc x. cnj c *⇩C x›.
lift_definition scaleR_conjugate_space :: ‹real ⇒ 'a conjugate_space ⇒ 'a conjugate_space› is ‹λr x. r *⇩R x›.
lift_definition plus_conjugate_space :: "'a conjugate_space ⇒ 'a conjugate_space ⇒ 'a conjugate_space" is "(+)".
lift_definition uminus_conjugate_space :: "'a conjugate_space ⇒ 'a conjugate_space" is ‹λx. -x›.
lift_definition zero_conjugate_space :: "'a conjugate_space" is 0.
lift_definition minus_conjugate_space :: "'a conjugate_space ⇒ 'a conjugate_space ⇒ 'a conjugate_space" is "(-)".
instance
apply (intro_classes; transfer)
by (simp_all add: scaleR_scaleC scaleC_add_right scaleC_left.add)
end
instantiation conjugate_space :: (complex_normed_vector) complex_normed_vector begin
lift_definition sgn_conjugate_space :: "'a conjugate_space ⇒ 'a conjugate_space" is "sgn".
lift_definition norm_conjugate_space :: "'a conjugate_space ⇒ real" is norm.
lift_definition dist_conjugate_space :: "'a conjugate_space ⇒ 'a conjugate_space ⇒ real" is dist.
lift_definition uniformity_conjugate_space :: "('a conjugate_space × 'a conjugate_space) filter" is uniformity.
lift_definition open_conjugate_space :: "'a conjugate_space set ⇒ bool" is "open".
instance
apply (intro_classes; transfer)
by (simp_all add: dist_norm sgn_div_norm open_uniformity uniformity_dist norm_triangle_ineq)
end
instantiation conjugate_space :: (cbanach) cbanach begin
instance
apply intro_classes
unfolding Cauchy_def convergent_def LIMSEQ_def apply transfer
using Cauchy_convergent unfolding Cauchy_def convergent_def LIMSEQ_def by metis
end
lemma bounded_antilinear_to_conjugate_space[simp]: ‹bounded_antilinear to_conjugate_space›
by (rule bounded_antilinear_intro[where K=1]; transfer; auto)
lemma bounded_antilinear_from_conjugate_space[simp]: ‹bounded_antilinear from_conjugate_space›
by (rule bounded_antilinear_intro[where K=1]; transfer; auto)
lemma antilinear_to_conjugate_space[simp]: ‹antilinear to_conjugate_space›
by (rule antilinearI; transfer, auto)
lemma antilinear_from_conjugate_space[simp]: ‹antilinear from_conjugate_space›
by (rule antilinearI; transfer, auto)
lemma cspan_to_conjugate_space[simp]: "cspan (to_conjugate_space ` X) = to_conjugate_space ` cspan X"
unfolding complex_vector.span_def complex_vector.subspace_def hull_def
apply transfer
apply simp
by (metis (no_types, hide_lams) complex_cnj_cnj)
lemma surj_to_conjugate_space[simp]: "surj to_conjugate_space"
by (meson surj_def to_conjugate_space_cases)
lemmas has_derivative_scaleC[simp, derivative_intros] =
bounded_bilinear.FDERIV[OF bounded_cbilinear_scaleC[THEN bounded_cbilinear.bounded_bilinear]]
lemma norm_to_conjugate_space[simp]: ‹norm (to_conjugate_space x) = norm x›
by (fact norm_conjugate_space.abs_eq)
lemma norm_from_conjugate_space[simp]: ‹norm (from_conjugate_space x) = norm x›
by (simp add: norm_conjugate_space.rep_eq)
lemma closure_to_conjugate_space: ‹closure (to_conjugate_space ` X) = to_conjugate_space ` closure X›
proof -
have 1: ‹to_conjugate_space ` closure X ⊆ closure (to_conjugate_space ` X)›
apply (rule closure_bounded_linear_image_subset)
by (simp add: bounded_antilinear.bounded_linear)
have ‹… = to_conjugate_space ` from_conjugate_space ` closure (to_conjugate_space ` X)›
by (simp add: from_conjugate_space_inverse image_image)
also have ‹… ⊆ to_conjugate_space ` closure (from_conjugate_space ` to_conjugate_space ` X)›
apply (rule image_mono)
apply (rule closure_bounded_linear_image_subset)
by (simp add: bounded_antilinear.bounded_linear)
also have ‹… = to_conjugate_space ` closure X›
by (simp add: to_conjugate_space_inverse image_image)
finally show ?thesis
using 1 by simp
qed
lemma closure_from_conjugate_space: ‹closure (from_conjugate_space ` X) = from_conjugate_space ` closure X›
proof -
have 1: ‹from_conjugate_space ` closure X ⊆ closure (from_conjugate_space ` X)›
apply (rule closure_bounded_linear_image_subset)
by (simp add: bounded_antilinear.bounded_linear)
have ‹… = from_conjugate_space ` to_conjugate_space ` closure (from_conjugate_space ` X)›
by (simp add: to_conjugate_space_inverse image_image)
also have ‹… ⊆ from_conjugate_space ` closure (to_conjugate_space ` from_conjugate_space ` X)›
apply (rule image_mono)
apply (rule closure_bounded_linear_image_subset)
by (simp add: bounded_antilinear.bounded_linear)
also have ‹… = from_conjugate_space ` closure X›
by (simp add: from_conjugate_space_inverse image_image)
finally show ?thesis
using 1 by simp
qed
lemma bounded_antilinear_eq_on:
fixes A B :: "'a::complex_normed_vector ⇒ 'b::complex_normed_vector"
assumes ‹bounded_antilinear A› and ‹bounded_antilinear B› and
eq: ‹⋀x. x ∈ G ⟹ A x = B x› and t: ‹t ∈ closure (cspan G)›
shows ‹A t = B t›
proof -
let ?A = ‹λx. A (from_conjugate_space x)› and ?B = ‹λx. B (from_conjugate_space x)›
and ?G = ‹to_conjugate_space ` G› and ?t = ‹to_conjugate_space t›
have ‹bounded_clinear ?A› and ‹bounded_clinear ?B›
by (auto intro!: bounded_antilinear_o_bounded_antilinear[OF ‹bounded_antilinear A›]
bounded_antilinear_o_bounded_antilinear[OF ‹bounded_antilinear B›])
moreover from eq have ‹⋀x. x ∈ ?G ⟹ ?A x = ?B x›
by (metis image_iff iso_tuple_UNIV_I to_conjugate_space_inverse)
moreover from t have ‹?t ∈ closure (cspan ?G)›
by (metis bounded_antilinear.bounded_linear bounded_antilinear_to_conjugate_space closure_bounded_linear_image_subset cspan_to_conjugate_space imageI subsetD)
ultimately have ‹?A ?t = ?B ?t›
by (rule bounded_clinear_eq_on)
then show ‹A t = B t›
by (simp add: to_conjugate_space_inverse)
qed
instantiation complex :: basis_enum begin
definition "canonical_basis = [1::complex]"
instance
proof
show "distinct (canonical_basis::complex list)"
by (simp add: canonical_basis_complex_def)
show "cindependent (set (canonical_basis::complex list))"
unfolding canonical_basis_complex_def
by auto
show "cspan (set (canonical_basis::complex list)) = UNIV"
unfolding canonical_basis_complex_def
apply (auto simp add: cspan_raw_def vector_space_over_itself.span_Basis)
by (metis complex_scaleC_def complex_vector.span_base complex_vector.span_scale cspan_raw_def insertI1 mult.right_neutral)
qed
end
lemma csubspace_is_convex[simp]:
assumes a1: "csubspace M"
shows "convex M"
proof-
have ‹∀x∈M. ∀y∈ M. ∀u. ∀v. u *⇩C x + v *⇩C y ∈ M›
using a1
by (simp add: complex_vector.subspace_def)
hence ‹∀x∈M. ∀y∈M. ∀u::real. ∀v::real. u *⇩R x + v *⇩R y ∈ M›
by (simp add: scaleR_scaleC)
hence ‹∀x∈M. ∀y∈M. ∀u≥0. ∀v≥0. u + v = 1 ⟶ u *⇩R x + v *⇩R y ∈M›
by blast
thus ?thesis using convex_def by blast
qed
lemma kernel_is_csubspace[simp]:
assumes a1: "clinear f"
shows "csubspace (f -` {0})"
proof-
have w3: ‹t *⇩C x ∈ {x. f x = 0}›
if b1: "x ∈ {x. f x = 0}"
for x t
by (metis assms complex_vector.linear_subspace_kernel complex_vector.subspace_def that)
have ‹f 0 = 0›
by (simp add: assms complex_vector.linear_0)
hence s2: ‹0 ∈ {x. f x = 0}›
by blast
have w4: "x + y ∈ {x. f x = 0}"
if c1: "x ∈ {x. f x = 0}" and c2: "y ∈ {x. f x = 0}"
for x y
using assms c1 c2 complex_vector.linear_add by fastforce
have s4: ‹c *⇩C t ∈ {x. f x = 0}›
if "t ∈ {x. f x = 0}"
for t c
using that w3 by auto
have s5: "u + v ∈ {x. f x = 0}"
if "u ∈ {x. f x = 0}" and "v ∈ {x. f x = 0}"
for u v
using w4 that(1) that(2) by auto
have f3: "f -` {b. b = 0 ∨ b ∈ {}} = {a. f a = 0}"
by blast
have "csubspace {a. f a = 0}"
by (metis complex_vector.subspace_def s2 s4 s5)
thus ?thesis
using f3 by auto
qed
lemma kernel_is_closed_csubspace[simp]:
assumes a1: "bounded_clinear f"
shows "closed_csubspace (f -` {0})"
proof-
have ‹csubspace (f -` {0})›
using assms bounded_clinear.clinear complex_vector.linear_subspace_vimage complex_vector.subspace_single_0 by blast
have "L ∈ {x. f x = 0}"
if "r ⇢ L" and "∀ n. r n ∈ {x. f x = 0}"
for r and L
proof-
have d1: ‹∀ n. f (r n) = 0›
using that(2) by auto
have ‹(λ n. f (r n)) ⇢ f L›
using assms clinear_continuous_at continuous_within_tendsto_compose' that(1)
by fastforce
hence ‹(λ n. 0) ⇢ f L›
using d1 by simp
hence ‹f L = 0›
using limI by fastforce
thus ?thesis by blast
qed
then have s3: ‹closed (f -` {0})›
using closed_sequential_limits by force
with ‹csubspace (f -` {0})›
show ?thesis
using closed_csubspace.intro by blast
qed
lemma range_is_clinear[simp]:
assumes a1: "clinear f"
shows "csubspace (range f)"
using assms complex_vector.linear_subspace_image complex_vector.subspace_UNIV by blast
lemma ccspan_superset:
‹A ⊆ space_as_set (ccspan A)›
for A :: ‹'a::complex_normed_vector set›
apply transfer
by (meson closure_subset complex_vector.span_superset subset_trans)
subsection ‹Product is a Complex Vector Space›
instantiation prod :: (complex_vector, complex_vector) complex_vector
begin
definition scaleC_prod_def:
"scaleC r A = (scaleC r (fst A), scaleC r (snd A))"
lemma fst_scaleC [simp]: "fst (scaleC r A) = scaleC r (fst A)"
unfolding scaleC_prod_def by simp
lemma snd_scaleC [simp]: "snd (scaleC r A) = scaleC r (snd A)"
unfolding scaleC_prod_def by simp
proposition scaleC_Pair [simp]: "scaleC r (a, b) = (scaleC r a, scaleC r b)"
unfolding scaleC_prod_def by simp
instance
proof
fix a b :: complex and x y :: "'a × 'b"
show "scaleC a (x + y) = scaleC a x + scaleC a y"
by (simp add: scaleC_add_right scaleC_prod_def)
show "scaleC (a + b) x = scaleC a x + scaleC b x"
by (simp add: Complex_Vector_Spaces.scaleC_prod_def scaleC_left.add)
show "scaleC a (scaleC b x) = scaleC (a * b) x"
by (simp add: prod_eq_iff)
show "scaleC 1 x = x"
by (simp add: prod_eq_iff)
show ‹(scaleR :: _ ⇒ _ ⇒ 'a*'b) r = (*⇩C) (complex_of_real r)› for r
by (auto intro!: ext simp: scaleR_scaleC scaleC_prod_def scaleR_prod_def)
qed
end
lemma module_prod_scale_eq_scaleC: "module_prod.scale (*⇩C) (*⇩C) = scaleC"
apply (rule ext) apply (rule ext)
apply (subst module_prod.scale_def)
subgoal by unfold_locales
by (simp add: scaleC_prod_def)
interpretation complex_vector?: vector_space_prod "scaleC::_⇒_⇒'a::complex_vector" "scaleC::_⇒_⇒'b::complex_vector"
rewrites "scale = ((*⇩C)::_⇒_⇒('a × 'b))"
and "module.dependent (*⇩C) = cdependent"
and "module.representation (*⇩C) = crepresentation"
and "module.subspace (*⇩C) = csubspace"
and "module.span (*⇩C) = cspan"
and "vector_space.extend_basis (*⇩C) = cextend_basis"
and "vector_space.dim (*⇩C) = cdim"
and "Vector_Spaces.linear (*⇩C) (*⇩C) = clinear"
subgoal by unfold_locales
subgoal by (fact module_prod_scale_eq_scaleC)
unfolding cdependent_raw_def crepresentation_raw_def csubspace_raw_def cspan_raw_def
cextend_basis_raw_def cdim_raw_def clinear_def
by (rule refl)+
subsection ‹Copying existing theorems into sublocales›
context bounded_clinear begin
interpretation bounded_linear f by (rule bounded_linear)
lemmas continuous = continuous
lemmas uniform_limit = uniform_limit
lemmas Cauchy = Cauchy
end
context bounded_antilinear begin
interpretation bounded_linear f by (rule bounded_linear)
lemmas continuous = continuous
lemmas uniform_limit = uniform_limit
end
context bounded_cbilinear begin
interpretation bounded_bilinear prod by simp
lemmas tendsto = tendsto
lemmas isCont = isCont
end
context bounded_sesquilinear begin
interpretation bounded_bilinear prod by simp
lemmas tendsto = tendsto
lemmas isCont = isCont
end
lemmas tendsto_scaleC [tendsto_intros] =
bounded_cbilinear.tendsto [OF bounded_cbilinear_scaleC]
end
Theory Complex_Inner_Product0
section ‹‹Complex_Inner_Product0› -- Inner Product Spaces and Gradient Derivative›
theory Complex_Inner_Product0
imports
Complex_Main Complex_Vector_Spaces
"HOL-Analysis.Inner_Product"
"Complex_Bounded_Operators.Extra_Ordered_Fields"
begin
subsection ‹Complex inner product spaces›
text ‹
Temporarily relax type constraints for \<^term>‹open›, \<^term>‹uniformity›,
\<^term>‹dist›, and \<^term>‹norm›.
›
setup ‹Sign.add_const_constraint
(\<^const_name>‹open›, SOME \<^typ>‹'a::open set ⇒ bool›)›
setup ‹Sign.add_const_constraint
(\<^const_name>‹dist›, SOME \<^typ>‹'a::dist ⇒ 'a ⇒ real›)›
setup ‹Sign.add_const_constraint
(\<^const_name>‹uniformity›, SOME \<^typ>‹('a::uniformity × 'a) filter›)›
setup ‹Sign.add_const_constraint
(\<^const_name>‹norm›, SOME \<^typ>‹'a::norm ⇒ real›)›
class complex_inner = complex_vector + sgn_div_norm + dist_norm + uniformity_dist + open_uniformity +
fixes cinner :: "'a ⇒ 'a ⇒ complex"
assumes cinner_commute: "cinner x y = cnj (cinner y x)"
and cinner_add_left: "cinner (x + y) z = cinner x z + cinner y z"
and cinner_scaleC_left [simp]: "cinner (scaleC r x) y = (cnj r) * (cinner x y)"
and cinner_ge_zero [simp]: "0 ≤ cinner x x"
and cinner_eq_zero_iff [simp]: "cinner x x = 0 ⟷ x = 0"
and norm_eq_sqrt_cinner: "norm x = sqrt (cmod (cinner x x))"
begin
lemma cinner_zero_left [simp]: "cinner 0 x = 0"
using cinner_add_left [of 0 0 x] by simp
lemma cinner_minus_left [simp]: "cinner (- x) y = - cinner x y"
using cinner_add_left [of x "- x" y]
by (simp add: group_add_class.add_eq_0_iff)
lemma cinner_diff_left: "cinner (x - y) z = cinner x z - cinner y z"
using cinner_add_left [of x "- y" z] by simp
lemma cinner_sum_left: "cinner (∑x∈A. f x) y = (∑x∈A. cinner (f x) y)"
by (cases "finite A", induct set: finite, simp_all add: cinner_add_left)
lemma call_zero_iff [simp]: "(∀u. cinner x u = 0) ⟷ (x = 0)"
by auto (use cinner_eq_zero_iff in blast)
text ‹Transfer distributivity rules to right argument.›
lemma cinner_add_right: "cinner x (y + z) = cinner x y + cinner x z"
using cinner_add_left [of y z x]
by (metis complex_cnj_add local.cinner_commute)
lemma cinner_scaleC_right [simp]: "cinner x (scaleC r y) = r * (cinner x y)"
using cinner_scaleC_left [of r y x]
by (metis complex_cnj_cnj complex_cnj_mult local.cinner_commute)
lemma cinner_zero_right [simp]: "cinner x 0 = 0"
using cinner_zero_left [of x]
by (metis (mono_tags, hide_lams) complex_cnj_zero local.cinner_commute)
lemma cinner_minus_right [simp]: "cinner x (- y) = - cinner x y"
using cinner_minus_left [of y x]
by (metis complex_cnj_minus local.cinner_commute)
lemma cinner_diff_right: "cinner x (y - z) = cinner x y - cinner x z"
using cinner_diff_left [of y z x]
by (metis complex_cnj_diff local.cinner_commute)
lemma cinner_sum_right: "cinner x (∑y∈A. f y) = (∑y∈A. cinner x (f y))"
proof (subst cinner_commute)
have "(∑y∈A. cinner (f y) x) = (∑y∈A. cinner (f y) x)"
by blast
hence "cnj (∑y∈A. cinner (f y) x) = cnj (∑y∈A. (cinner (f y) x))"
by simp
hence "cnj (cinner (sum f A) x) = (∑y∈A. cnj (cinner (f y) x))"
by (simp add: cinner_sum_left)
thus "cnj (cinner (sum f A) x) = (∑y∈A. (cinner x (f y)))"
by (subst (2) cinner_commute)
qed
lemmas cinner_add [algebra_simps] = cinner_add_left cinner_add_right
lemmas cinner_diff [algebra_simps] = cinner_diff_left cinner_diff_right
lemmas cinner_scaleC = cinner_scaleC_left cinner_scaleC_right
lemma cinner_gt_zero_iff [simp]: "0 < cinner x x ⟷ x ≠ 0"
by (smt (verit) less_irrefl local.cinner_eq_zero_iff local.cinner_ge_zero order.not_eq_order_implies_strict)
lemma power2_norm_eq_cinner:
shows "(complex_of_real (norm x))⇧2 = (cinner x x)"
by (smt (verit, del_insts) Im_complex_of_real Re_complex_of_real cinner_gt_zero_iff cinner_zero_right cmod_def complex_eq_0 complex_eq_iff less_complex_def local.norm_eq_sqrt_cinner of_real_power real_sqrt_abs real_sqrt_pow2_iff zero_complex.sel(1))
lemma power2_norm_eq_cinner':
shows "(norm x)⇧2 = Re (cinner x x)"
by (metis Re_complex_of_real of_real_power power2_norm_eq_cinner)
text ‹Identities involving real multiplication and division.›
lemma cinner_mult_left: "cinner (of_complex m * a) b = cnj m * (cinner a b)"
by (simp add: of_complex_def)
lemma cinner_mult_right: "cinner a (of_complex m * b) = m * (cinner a b)"
by (metis complex_inner_class.cinner_scaleC_right scaleC_conv_of_complex)
lemma cinner_mult_left': "cinner (a * of_complex m) b = cnj m * (cinner a b)"
by (metis cinner_mult_left mult.right_neutral mult_scaleC_right scaleC_conv_of_complex)
lemma cinner_mult_right': "cinner a (b * of_complex m) = (cinner a b) * m"
by (simp add: complex_inner_class.cinner_scaleC_right of_complex_def)
lemma Cauchy_Schwarz_ineq:
"(cinner x y) * (cinner y x) ≤ cinner x x * cinner y y"
proof (cases)
assume "y = 0"
thus ?thesis by simp
next
assume y: "y ≠ 0"
have [simp]: "cnj (cinner y y) = cinner y y" for y
by (metis cinner_commute)
define r where "r = cnj (cinner x y) / cinner y y"
have "0 ≤ cinner (x - scaleC r y) (x - scaleC r y)"
by (rule cinner_ge_zero)
also have "… = cinner x x - r * cinner x y - cnj r * cinner y x + r * cnj r * cinner y y"
unfolding cinner_diff_left cinner_diff_right cinner_scaleC_left cinner_scaleC_right
by (smt (z3) cancel_comm_monoid_add_class.diff_cancel cancel_comm_monoid_add_class.diff_zero complex_cnj_divide group_add_class.diff_add_cancel local.cinner_commute local.cinner_eq_zero_iff local.cinner_scaleC_left mult.assoc mult.commute mult_eq_0_iff nonzero_eq_divide_eq r_def y)
also have "… = cinner x x - cinner y x * cnj r"
unfolding r_def by auto
also have "… = cinner x x - cinner x y * cnj (cinner x y) / cinner y y"
unfolding r_def
by (metis complex_cnj_divide local.cinner_commute mult.commute times_divide_eq_left)
finally have "0 ≤ cinner x x - cinner x y * cnj (cinner x y) / cinner y y" .
hence "cinner x y * cnj (cinner x y) / cinner y y ≤ cinner x x"
by (simp add: le_diff_eq)
thus "cinner x y * cinner y x ≤ cinner x x * cinner y y"
by (metis cinner_gt_zero_iff local.cinner_commute nice_ordered_field_class.pos_divide_le_eq y)
qed
lemma Cauchy_Schwarz_ineq2:
shows "norm (cinner x y) ≤ norm x * norm y"
proof (rule power2_le_imp_le)
have "(norm (cinner x y))^2 = Re (cinner x y * cinner y x)"
by (metis (full_types) Re_complex_of_real complex_norm_square local.cinner_commute)
also have "… ≤ Re (cinner x x * cinner y y)"
using Cauchy_Schwarz_ineq by (rule Re_mono)
also have "… = Re (complex_of_real ((norm x)^2) * complex_of_real ((norm y)^2))"
by (simp add: power2_norm_eq_cinner)
also have "… = (norm x * norm y)⇧2"
by (simp add: power_mult_distrib)
finally show "(cmod (cinner x y))^2 ≤ (norm x * norm y)⇧2" .
show "0 ≤ norm x * norm y"
by (simp add: local.norm_eq_sqrt_cinner)
qed
subclass complex_normed_vector
proof
fix a :: complex and r :: real and x y :: 'a
show "norm x = 0 ⟷ x = 0"
unfolding norm_eq_sqrt_cinner by simp
show "norm (x + y) ≤ norm x + norm y"
proof (rule power2_le_imp_le)
have "Re (cinner x y) ≤ cmod (cinner x y)"
if "⋀x. Re x ≤ cmod x" and
"⋀x y. x ≤ y ⟹ complex_of_real x ≤ complex_of_real y"
using that by simp
hence a1: "2 * Re (cinner x y) ≤ 2 * cmod (cinner x y)"
if "⋀x. Re x ≤ cmod x" and
"⋀x y. x ≤ y ⟹ complex_of_real x ≤ complex_of_real y"
using that by simp
have "cinner x y + cinner y x = complex_of_real (2 * Re (cinner x y))"
by (metis complex_add_cnj local.cinner_commute)
also have "… ≤ complex_of_real (2 * cmod (cinner x y))"
using complex_Re_le_cmod complex_of_real_mono a1
by blast
also have "… = 2 * abs (cinner x y)"
unfolding abs_complex_def by simp
also have "… ≤ 2 * complex_of_real (norm x) * complex_of_real (norm y)"
using Cauchy_Schwarz_ineq2 unfolding abs_complex_def by auto
finally have xyyx: "cinner x y + cinner y x ≤ complex_of_real (2 * norm x * norm y)"
by auto
have "complex_of_real ((norm (x + y))⇧2) = cinner (x+y) (x+y)"
by (simp add: power2_norm_eq_cinner)
also have "… = cinner x x + cinner x y + cinner y x + cinner y y"
by (simp add: cinner_add)
also have "… = complex_of_real ((norm x)⇧2) + complex_of_real ((norm y)⇧2) + cinner x y + cinner y x"
by (simp add: power2_norm_eq_cinner)
also have "… ≤ complex_of_real ((norm x)⇧2) + complex_of_real ((norm y)⇧2) + complex_of_real (2 * norm x * norm y)"
using xyyx by auto
also have "… = complex_of_real ((norm x + norm y)⇧2)"
unfolding power2_sum by auto
finally show "(norm (x + y))⇧2 ≤ (norm x + norm y)⇧2"
using complex_of_real_mono_iff by blast
show "0 ≤ norm x + norm y"
unfolding norm_eq_sqrt_cinner by simp
qed
show norm_scaleC: "norm (a *⇩C x) = cmod a * norm x" for a
proof (rule power2_eq_imp_eq)
show "(norm (a *⇩C x))⇧2 = (cmod a * norm x)⇧2"
by (simp_all add: norm_eq_sqrt_cinner norm_mult power2_eq_square)
show "0 ≤ norm (a *⇩C x)"
by (simp_all add: norm_eq_sqrt_cinner)
show "0 ≤ cmod a * norm x"
by (simp_all add: norm_eq_sqrt_cinner)
qed
show "norm (r *⇩R x) = ¦r¦ * norm x"
unfolding scaleR_scaleC norm_scaleC by auto
qed
end
lemma csquare_continuous:
fixes e :: real
shows "e > 0 ⟹ ∃d. 0 < d ∧ (∀y. cmod (y - x) < d ⟶ cmod (y * y - x * x) < e)"
using isCont_power[OF continuous_ident, of x, unfolded isCont_def LIM_eq, rule_format, of e 2]
by (force simp add: power2_eq_square)
lemma cnorm_le: "norm x ≤ norm y ⟷ cinner x x ≤ cinner y y"
by (smt (verit) complex_of_real_mono_iff norm_eq_sqrt_cinner norm_ge_zero of_real_power power2_norm_eq_cinner real_sqrt_le_mono real_sqrt_pow2)
lemma cnorm_lt: "norm x < norm y ⟷ cinner x x < cinner y y"
by (meson cnorm_le less_le_not_le)
lemma cnorm_eq: "norm x = norm y ⟷ cinner x x = cinner y y"
by (metis norm_eq_sqrt_cinner power2_norm_eq_cinner)
lemma cnorm_eq_1: "norm x = 1 ⟷ cinner x x = 1"
by (metis cinner_ge_zero complex_of_real_cmod norm_eq_sqrt_cinner norm_one of_real_1 real_sqrt_eq_iff real_sqrt_one)
lemma cinner_divide_left:
fixes a :: "'a :: {complex_inner,complex_div_algebra}"
shows "cinner (a / of_complex m) b = (cinner a b) / cnj m"
by (metis cinner_mult_left' complex_cnj_inverse divide_inverse of_complex_inverse ordered_field_class.sign_simps(33))
lemma cinner_divide_right:
fixes a :: "'a :: {complex_inner,complex_div_algebra}"
shows "cinner a (b / of_complex m) = (cinner a b) / m"
by (metis cinner_mult_right' divide_inverse of_complex_inverse)
text ‹
Re-enable constraints for \<^term>‹open›, \<^term>‹uniformity›,
\<^term>‹dist›, and \<^term>‹norm›.
›
setup ‹Sign.add_const_constraint
(\<^const_name>‹open›, SOME \<^typ>‹'a::topological_space set ⇒ bool›)›
setup ‹Sign.add_const_constraint
(\<^const_name>‹uniformity›, SOME \<^typ>‹('a::uniform_space × 'a) filter›)›
setup ‹Sign.add_const_constraint
(\<^const_name>‹dist›, SOME \<^typ>‹'a::metric_space ⇒ 'a ⇒ real›)›
setup ‹Sign.add_const_constraint
(\<^const_name>‹norm›, SOME \<^typ>‹'a::real_normed_vector ⇒ real›)›
lemma bounded_sesquilinear_cinner:
"bounded_sesquilinear (cinner::'a::complex_inner ⇒ 'a ⇒ complex)"
proof
fix x y z :: 'a and r :: complex
show "cinner (x + y) z = cinner x z + cinner y z"
by (rule cinner_add_left)
show "cinner x (y + z) = cinner x y + cinner x z"
by (rule cinner_add_right)
show "cinner (scaleC r x) y = scaleC (cnj r) (cinner x y)"
unfolding complex_scaleC_def by (rule cinner_scaleC_left)
show "cinner x (scaleC r y) = scaleC r (cinner x y)"
unfolding complex_scaleC_def by (rule cinner_scaleC_right)
have "∀x y::'a. norm (cinner x y) ≤ norm x * norm y * 1"
by (simp add: complex_inner_class.Cauchy_Schwarz_ineq2)
thus "∃K. ∀x y::'a. norm (cinner x y) ≤ norm x * norm y * K"
by metis
qed
lemmas tendsto_cinner [tendsto_intros] =
bounded_bilinear.tendsto [OF bounded_sesquilinear_cinner[THEN bounded_sesquilinear.bounded_bilinear]]
lemmas isCont_cinner [simp] =
bounded_bilinear.isCont [OF bounded_sesquilinear_cinner[THEN bounded_sesquilinear.bounded_bilinear]]
lemmas has_derivative_cinner [derivative_intros] =
bounded_bilinear.FDERIV [OF bounded_sesquilinear_cinner[THEN bounded_sesquilinear.bounded_bilinear]]
lemmas bounded_antilinear_cinner_left =
bounded_sesquilinear.bounded_antilinear_left [OF bounded_sesquilinear_cinner]
lemmas bounded_clinear_cinner_right =
bounded_sesquilinear.bounded_clinear_right [OF bounded_sesquilinear_cinner]
lemmas bounded_antilinear_cinner_left_comp = bounded_antilinear_cinner_left[THEN bounded_antilinear_o_bounded_clinear]
lemmas bounded_clinear_cinner_right_comp = bounded_clinear_cinner_right[THEN bounded_clinear_compose]
lemmas has_derivative_cinner_right [derivative_intros] =
bounded_linear.has_derivative [OF bounded_clinear_cinner_right[THEN bounded_clinear.bounded_linear]]
lemmas has_derivative_cinner_left [derivative_intros] =
bounded_linear.has_derivative [OF bounded_antilinear_cinner_left[THEN bounded_antilinear.bounded_linear]]
lemma differentiable_cinner [simp]:
"f differentiable (at x within s) ⟹ g differentiable at x within s ⟹ (λx. cinner (f x) (g x)) differentiable at x within s"
unfolding differentiable_def by (blast intro: has_derivative_cinner)
subsection ‹Class instances›
instantiation complex :: complex_inner
begin
definition cinner_complex_def [simp]: "cinner x y = cnj x * y"
instance
proof
fix x y z r :: complex
show "cinner x y = cnj (cinner y x)"
unfolding cinner_complex_def by auto
show "cinner (x + y) z = cinner x z + cinner y z"
unfolding cinner_complex_def
by (simp add: ring_class.ring_distribs(2))
show "cinner (scaleC r x) y = cnj r * cinner x y"
unfolding cinner_complex_def complex_scaleC_def by simp
show "0 ≤ cinner x x"
by simp
show "cinner x x = 0 ⟷ x = 0"
unfolding cinner_complex_def by simp
have "cmod (Complex x1 x2) = sqrt (cmod (cinner (Complex x1 x2) (Complex x1 x2)))"
for x1 x2
unfolding cinner_complex_def complex_cnj complex_mult complex_norm
by (simp add: power2_eq_square)
thus "norm x = sqrt (cmod (cinner x x))"
by (cases x, hypsubst_thin)
qed
end
lemma
shows complex_inner_1_left[simp]: "cinner 1 x = x"
and complex_inner_1_right[simp]: "cinner x 1 = cnj x"
by simp_all
lemma cdot_square_norm: "cinner x x = complex_of_real ((norm x)⇧2)"
by (metis Im_complex_of_real Re_complex_of_real cinner_ge_zero complex_eq_iff less_eq_complex_def power2_norm_eq_cinner' zero_complex.simps(2))
lemma cnorm_eq_square: "norm x = a ⟷ 0 ≤ a ∧ cinner x x = complex_of_real (a⇧2)"
by (metis cdot_square_norm norm_ge_zero of_real_eq_iff power2_eq_iff_nonneg)
lemma cnorm_le_square: "norm x ≤ a ⟷ 0 ≤ a ∧ cinner x x ≤ complex_of_real (a⇧2)"
by (smt (verit) cdot_square_norm complex_of_real_mono_iff norm_ge_zero power2_le_imp_le)
lemma cnorm_ge_square: "norm x ≥ a ⟷ a ≤ 0 ∨ cinner x x ≥ complex_of_real (a⇧2)"
by (smt (verit, best) antisym_conv cnorm_eq_square cnorm_le_square complex_of_real_nn_iff nn_comparable zero_le_power2)
lemma norm_lt_square: "norm x < a ⟷ 0 < a ∧ cinner x x < complex_of_real (a⇧2)"
by (meson cnorm_ge_square cnorm_le_square less_le_not_le)
lemma norm_gt_square: "norm x > a ⟷ a < 0 ∨ cinner x x > complex_of_real (a⇧2)"
by (smt (verit, ccfv_SIG) cdot_square_norm complex_of_real_strict_mono_iff norm_ge_zero power2_eq_imp_eq power_mono)
text‹Dot product in terms of the norm rather than conversely.›
lemmas cinner_simps = cinner_add_left cinner_add_right cinner_diff_right cinner_diff_left
cinner_scaleC_left cinner_scaleC_right
lemma cdot_norm: "cinner x y = ((norm (x+y))⇧2 - (norm (x-y))⇧2 - 𝗂 * (norm (x + 𝗂 *⇩C y))⇧2 + 𝗂 * (norm (x - 𝗂 *⇩C y))⇧2) / 4"
unfolding power2_norm_eq_cinner
by (simp add: power2_norm_eq_cinner cinner_add_left cinner_add_right
cinner_diff_left cinner_diff_right ring_distribs)
lemma of_complex_inner_1 [simp]:
"cinner (of_complex x) (1 :: 'a :: {complex_inner, complex_normed_algebra_1}) = cnj x"
by (metis Complex_Inner_Product0.complex_inner_1_right cinner_complex_def cinner_mult_left complex_cnj_one norm_one of_complex_def power2_norm_eq_cinner scaleC_conv_of_complex)
lemma summable_of_complex_iff:
"summable (λx. of_complex (f x) :: 'a :: {complex_normed_algebra_1,complex_inner}) ⟷ summable f"
proof
assume *: "summable (λx. of_complex (f x) :: 'a)"
have "bounded_clinear (cinner (1::'a))"
by (rule bounded_clinear_cinner_right)
then interpret bounded_linear "λx::'a. cinner 1 x"
by (rule bounded_clinear.bounded_linear)
from summable [OF *] show "summable f"
apply (subst (asm) cinner_commute) by simp
next
assume sum: "summable f"
thus "summable (λx. of_complex (f x) :: 'a)"
by (rule summable_of_complex)
qed
subsection ‹Gradient derivative›
definition
cgderiv :: "['a::complex_inner ⇒ complex, 'a, 'a] ⇒ bool"
("(cGDERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
where
"cGDERIV f x :> D ⟷ FDERIV f x :> cinner D"
lemma cgderiv_deriv [simp]: "cGDERIV f x :> D ⟷ DERIV f x :> cnj D"
by (simp only: cgderiv_def has_field_derivative_def cinner_complex_def[THEN ext])
lemma cGDERIV_DERIV_compose:
assumes "cGDERIV f x :> df" and "DERIV g (f x) :> cnj dg"
shows "cGDERIV (λx. g (f x)) x :> scaleC dg df"
proof (insert assms)
show "cGDERIV (λx. g (f x)) x :> dg *⇩C df"
if "cGDERIV f x :> df"
and "(g has_field_derivative cnj dg) (at (f x))"
unfolding cgderiv_def has_field_derivative_def cinner_scaleC_left complex_cnj_cnj
using that
by (simp add: cgderiv_def has_derivative_compose has_field_derivative_imp_has_derivative)
qed
lemma cGDERIV_subst: "⟦cGDERIV f x :> df; df = d⟧ ⟹ cGDERIV f x :> d"
by simp
lemma cGDERIV_const: "cGDERIV (λx. k) x :> 0"
unfolding cgderiv_def cinner_zero_left[THEN ext] by (rule has_derivative_const)
lemma cGDERIV_add:
"⟦cGDERIV f x :> df; cGDERIV g x :> dg⟧
⟹ cGDERIV (λx. f x + g x) x :> df + dg"
unfolding cgderiv_def cinner_add_left[THEN ext] by (rule has_derivative_add)
lemma cGDERIV_minus:
"cGDERIV f x :> df ⟹ cGDERIV (λx. - f x) x :> - df"
unfolding cgderiv_def cinner_minus_left[THEN ext] by (rule has_derivative_minus)
lemma cGDERIV_diff:
"⟦cGDERIV f x :> df; cGDERIV g x :> dg⟧
⟹ cGDERIV (λx. f x - g x) x :> df - dg"
unfolding cgderiv_def cinner_diff_left by (rule has_derivative_diff)
lemma cGDERIV_scaleC:
"⟦DERIV f x :> df; cGDERIV g x :> dg⟧
⟹ cGDERIV (λx. scaleC (f x) (g x)) x
:> (scaleC (cnj (f x)) dg + scaleC (cnj df) (cnj (g x)))"
unfolding cgderiv_def has_field_derivative_def cinner_add_left cinner_scaleC_left
apply (rule has_derivative_subst)
apply (erule (1) has_derivative_scaleC)
by (simp add: ac_simps)
lemma GDERIV_mult:
"⟦cGDERIV f x :> df; cGDERIV g x :> dg⟧
⟹ cGDERIV (λx. f x * g x) x :> cnj (f x) *⇩C dg + cnj (g x) *⇩C df"
unfolding cgderiv_def
apply (rule has_derivative_subst)
apply (erule (1) has_derivative_mult)
apply (rule ext)
by (simp add: cinner_add ac_simps)
lemma cGDERIV_inverse:
"⟦cGDERIV f x :> df; f x ≠ 0⟧
⟹ cGDERIV (λx. inverse (f x)) x :> - cnj ((inverse (f x))⇧2) *⇩C df"
by (metis DERIV_inverse cGDERIV_DERIV_compose complex_cnj_cnj complex_cnj_minus numerals(2))
lemma has_derivative_norm[derivative_intros]:
fixes x :: "'a::complex_inner"
assumes "x ≠ 0"
shows "(norm has_derivative (λh. Re (cinner (sgn x) h))) (at x)"
thm has_derivative_norm
proof -
have Re_pos: "0 < Re (cinner x x)"
using assms
by (metis Re_strict_mono cinner_gt_zero_iff zero_complex.simps(1))
have Re_plus_Re: "Re (cinner x y) + Re (cinner y x) = 2 * Re (cinner x y)"
for x y :: 'a
by (metis cinner_commute cnj.simps(1) mult_2_right semiring_normalization_rules(7))
have norm: "norm x = sqrt (Re (cinner x x))" for x :: 'a
apply (subst norm_eq_sqrt_cinner, subst cmod_Re)
using cinner_ge_zero by auto
have v2:"((λx. sqrt (Re (cinner x x))) has_derivative
(λxa. (Re (cinner x xa) + Re (cinner xa x)) * (inverse (sqrt (Re (cinner x x))) / 2))) (at x)"
by (rule derivative_eq_intros | simp add: Re_pos)+
have v1: "((λx. sqrt (Re (cinner x x))) has_derivative (λy. Re (cinner x y) / sqrt (Re (cinner x x)))) (at x)"
if "((λx. sqrt (Re (cinner x x))) has_derivative (λxa. Re (cinner x xa) * inverse (sqrt (Re (cinner x x))))) (at x)"
using that apply (subst divide_real_def)
by simp
have ‹(norm has_derivative (λy. Re (cinner x y) / norm x)) (at x)›
using v2
apply (auto simp: Re_plus_Re norm [abs_def])
using v1 by blast
then show ?thesis
by (auto simp: power2_eq_square sgn_div_norm scaleR_scaleC)
qed
bundle cinner_syntax begin
notation cinner (infix "∙⇩C" 70)
end
bundle no_cinner_syntax begin
no_notation cinner (infix "∙⇩C" 70)
end
end
Theory Complex_Inner_Product
section ‹‹Complex_Inner_Product› -- Complex Inner Product Spaces›
theory Complex_Inner_Product
imports
Complex_Vector_Spaces
"HOL-Analysis.Infinite_Set_Sum"
Complex_Inner_Product0
begin
subsection ‹Complex inner product spaces›
bundle cinner_bracket_notation begin
notation cinner ("⟨_, _⟩")
end
unbundle cinner_bracket_notation
bundle no_cinner_bracket_notation begin
no_notation cinner ("⟨_, _⟩")
end
lemma cinner_real: "cinner x x ∈ ℝ"
by (meson cinner_ge_zero reals_zero_comparable_iff)
lemmas cinner_commute' [simp] = cinner_commute[symmetric]
lemma (in complex_inner) cinner_eq_flip: ‹(cinner x y = cinner z w) ⟷ (cinner y x = cinner w z)›
by (metis cinner_commute)
lemma Im_cinner_x_x[simp]: "Im ⟨x , x⟩ = 0"
using comp_Im_same[OF cinner_ge_zero] by simp
lemma of_complex_inner_1' [simp]:
"cinner (1 :: 'a :: {complex_inner, complex_normed_algebra_1}) (of_complex x) = x"
by (metis cinner_commute complex_cnj_cnj of_complex_inner_1)
class chilbert_space = complex_inner + complete_space
begin
subclass cbanach by standard
end
instantiation complex :: "chilbert_space" begin
instance ..
end
subsection ‹Misc facts›
text ‹This is a useful rule for establishing the equality of vectors›
lemma cinner_extensionality:
assumes ‹⋀γ. ⟨γ, ψ⟩ = ⟨γ, φ⟩›
shows ‹ψ = φ›
by (metis assms cinner_eq_zero_iff cinner_simps(3) right_minus_eq)
lemma polar_identity:
includes notation_norm
shows ‹∥x + y∥^2 = ∥x∥^2 + ∥y∥^2 + 2*Re ⟨x, y⟩›
proof -
have ‹⟨x , y⟩ + ⟨y , x⟩ = ⟨x , y⟩ + cnj ⟨x , y⟩›
by simp
hence ‹⟨x , y⟩ + ⟨y , x⟩ = 2 * Re ⟨x , y⟩ ›
using complex_add_cnj by presburger
have ‹∥x + y∥^2 = ⟨x+y, x+y⟩›
by (simp add: cdot_square_norm)
hence ‹∥x + y∥^2 = ⟨x , x⟩ + ⟨x , y⟩ + ⟨y , x⟩ + ⟨y , y⟩›
by (simp add: cinner_add_left cinner_add_right)
thus ?thesis using ‹⟨x , y⟩ + ⟨y , x⟩ = 2 * Re ⟨x , y⟩›
by (smt (verit, ccfv_SIG) Re_complex_of_real plus_complex.simps(1) power2_norm_eq_cinner')
qed
lemma polar_identity_minus:
includes notation_norm
shows ‹∥x - y∥^2 = ∥x∥^2 + ∥y∥^2 - 2 * Re ⟨x, y⟩›
proof-
have ‹∥x + (-y)∥^2 = ∥x∥^2 + ∥-y∥^2 + 2 * Re ⟨x , (-y)⟩›
using polar_identity by blast
hence ‹∥x - y∥^2 = ∥x∥^2 + ∥y∥^2 - 2*Re ⟨x , y⟩›
by simp
thus ?thesis
by blast
qed
proposition parallelogram_law:
includes notation_norm
fixes x y :: "'a::complex_inner"
shows ‹∥x+y∥^2 + ∥x-y∥^2 = 2*( ∥x∥^2 + ∥y∥^2 )›
by (simp add: polar_identity_minus polar_identity)
theorem pythagorean_theorem:
includes notation_norm
shows ‹⟨x , y⟩ = 0 ⟹ ∥ x + y ∥^2 = ∥ x ∥^2 + ∥ y ∥^2›
by (simp add: polar_identity)
lemma pythagorean_theorem_sum:
assumes q1: "⋀a a'. a ∈ t ⟹ a' ∈ t ⟹ a ≠ a' ⟹ ⟨f a, f a'⟩ = 0"
and q2: "finite t"
shows "(norm (∑a∈t. f a))^2 = (∑a∈t.(norm (f a))^2)"
proof (insert q1, use q2 in induction)
case empty
show ?case
by auto
next
case (insert x F)
have r1: "⟨f x, f a⟩ = 0"
if "a ∈ F"
for a
using that insert.hyps(2) insert.prems by auto
have "sum f F = (∑a∈F. f a)"
by simp
hence s4: "⟨f x, sum f F⟩ = ⟨f x, (∑a∈F. f a)⟩"
by simp
also have s3: "… = (∑a∈F. ⟨f x, f a⟩)"
using cinner_sum_right by auto
also have s2: "… = (∑a∈F. 0)"
using r1
by simp
also have s1: "… = 0"
by simp
finally have xF_ortho: "⟨f x, sum f F⟩ = 0"
using s2 s3 by auto
have "(norm (sum f (insert x F)))⇧2 = (norm (f x + sum f F))⇧2"
by (simp add: insert.hyps(1) insert.hyps(2))
also have "… = (norm (f x))⇧2 + (norm (sum f F))⇧2"
using xF_ortho by (rule pythagorean_theorem)
also have "… = (norm (f x))⇧2 + (∑a∈F.(norm (f a))^2)"
apply (subst insert.IH) using insert.prems by auto
also have "… = (∑a∈insert x F.(norm (f a))^2)"
by (simp add: insert.hyps(1) insert.hyps(2))
finally show ?case
by simp
qed
lemma Cauchy_cinner_Cauchy:
fixes x y :: ‹nat ⇒ 'a::complex_inner›
assumes a1: ‹Cauchy x› and a2: ‹Cauchy y›
shows ‹Cauchy (λ n. ⟨ x n, y n ⟩)›
proof-
have ‹bounded (range x)›
using a1
by (simp add: Elementary_Metric_Spaces.cauchy_imp_bounded)
hence b1: ‹∃M. ∀n. norm (x n) < M›
by (meson bounded_pos_less rangeI)
have ‹bounded (range y)›
using a2
by (simp add: Elementary_Metric_Spaces.cauchy_imp_bounded)
hence b2: ‹∃ M. ∀ n. norm (y n) < M›
by (meson bounded_pos_less rangeI)
have ‹∃M. ∀n. norm (x n) < M ∧ norm (y n) < M›
using b1 b2
by (metis dual_order.strict_trans linorder_neqE_linordered_idom)
then obtain M where M1: ‹⋀n. norm (x n) < M› and M2: ‹⋀n. norm (y n) < M›
by blast
have M3: ‹M > 0›
by (smt M2 norm_not_less_zero)
have ‹∃N. ∀n ≥ N. ∀m ≥ N. norm ( (λ i. ⟨ x i, y i ⟩) n - (λ i. ⟨ x i, y i ⟩) m ) < e›
if "e > 0" for e
proof-
have ‹e / (2*M) > 0›
using M3
by (simp add: that)
hence ‹∃N. ∀n≥N. ∀m≥N. norm (x n - x m) < e / (2*M)›
using a1
by (simp add: Cauchy_iff)
then obtain N1 where N1_def: ‹⋀n m. n≥N1 ⟹ m≥N1 ⟹ norm (x n - x m) < e / (2*M)›
by blast
have x1: ‹∃N. ∀ n≥N. ∀ m≥N. norm (y n - y m) < e / (2*M)›
using a2 ‹e / (2*M) > 0›
by (simp add: Cauchy_iff)
obtain N2 where N2_def: ‹⋀n m. n≥N2 ⟹ m≥N2 ⟹ norm (y n - y m) < e / (2*M)›
using x1
by blast
define N where N_def: ‹N = N1 + N2›
hence ‹N ≥ N1›
by auto
have ‹N ≥ N2›
using N_def
by auto
have ‹norm ( ⟨ x n, y n ⟩ - ⟨ x m, y m ⟩ ) < e›
if ‹n ≥ N› and ‹m ≥ N›
for n m
proof -
have ‹⟨ x n, y n ⟩ - ⟨ x m, y m ⟩ = (⟨ x n, y n ⟩ - ⟨ x m, y n ⟩) + (⟨ x m, y n ⟩ - ⟨ x m, y m ⟩)›
by simp
hence y1: ‹norm (⟨ x n, y n ⟩ - ⟨ x m, y m ⟩) ≤ norm (⟨ x n, y n ⟩ - ⟨ x m, y n ⟩)
+ norm (⟨ x m, y n ⟩ - ⟨ x m, y m ⟩)›
by (metis norm_triangle_ineq)
have ‹⟨ x n, y n ⟩ - ⟨ x m, y n ⟩ = ⟨ x n - x m, y n ⟩›
by (simp add: cinner_diff_left)
hence ‹norm (⟨ x n, y n ⟩ - ⟨ x m, y n ⟩) = norm ⟨ x n - x m, y n ⟩›
by simp
moreover have ‹norm ⟨ x n - x m, y n ⟩ ≤ norm (x n - x m) * norm (y n)›
using complex_inner_class.Cauchy_Schwarz_ineq2 by blast
moreover have ‹norm (y n) < M›
by (simp add: M2)
moreover have ‹norm (x n - x m) < e/(2*M)›
using ‹N ≤ m› ‹N ≤ n› ‹N1 ≤ N› N1_def by auto
ultimately have ‹norm (⟨ x n, y n ⟩ - ⟨ x m, y n ⟩) < (e/(2*M)) * M›
by (smt linordered_semiring_strict_class.mult_strict_mono norm_ge_zero)
moreover have ‹ (e/(2*M)) * M = e/2›
using ‹M > 0› by simp
ultimately have ‹norm (⟨ x n, y n ⟩ - ⟨ x m, y n ⟩) < e/2›
by simp
hence y2: ‹norm (⟨ x n, y n ⟩ - ⟨ x m, y n ⟩) < e/2›
by blast
have ‹⟨ x m, y n ⟩ - ⟨ x m, y m ⟩ = ⟨ x m, y n - y m ⟩›
by (simp add: cinner_diff_right)
hence ‹norm (⟨ x m, y n ⟩ - ⟨ x m, y m ⟩) = norm ⟨ x m, y n - y m ⟩›
by simp
moreover have ‹norm ⟨ x m, y n - y m ⟩ ≤ norm (x m) * norm (y n - y m)›
by (meson complex_inner_class.Cauchy_Schwarz_ineq2)
moreover have ‹norm (x m) < M›
by (simp add: M1)
moreover have ‹norm (y n - y m) < e/(2*M)›
using ‹N ≤ m› ‹N ≤ n› ‹N2 ≤ N› N2_def by auto
ultimately have ‹norm (⟨ x m, y n ⟩ - ⟨ x m, y m ⟩) < M * (e/(2*M))›
by (smt linordered_semiring_strict_class.mult_strict_mono norm_ge_zero)
moreover have ‹M * (e/(2*M)) = e/2›
using ‹M > 0› by simp
ultimately have ‹norm (⟨ x m, y n ⟩ - ⟨ x m, y m ⟩) < e/2›
by simp
hence y3: ‹norm (⟨ x m, y n ⟩ - ⟨ x m, y m ⟩) < e/2›
by blast
show ‹norm ( ⟨ x n, y n ⟩ - ⟨ x m, y m ⟩ ) < e›
using y1 y2 y3 by simp
qed
thus ?thesis by blast
qed
thus ?thesis
by (simp add: CauchyI)
qed
lemma cinner_sup_norm: ‹norm ψ = (SUP φ. cmod (cinner φ ψ) / norm φ)›
proof (rule sym, rule cSup_eq_maximum)
have ‹norm ψ = cmod (cinner ψ ψ) / norm ψ›
by (metis norm_eq_sqrt_cinner norm_ge_zero real_div_sqrt)
then show ‹norm ψ ∈ range (λφ. cmod (cinner φ ψ) / norm φ)›
by blast
next
fix n assume ‹n ∈ range (λφ. cmod (cinner φ ψ) / norm φ)›
then obtain φ where nφ: ‹n = cmod (cinner φ ψ) / norm φ›
by auto
show ‹n ≤ norm ψ›
unfolding nφ
by (simp add: complex_inner_class.Cauchy_Schwarz_ineq2 divide_le_eq ordered_field_class.sign_simps(33))
qed
lemma cinner_sup_onorm:
fixes A :: ‹'a::{real_normed_vector,not_singleton} ⇒ 'b::complex_inner›
assumes ‹bounded_linear A›
shows ‹onorm A = (SUP (ψ,φ). cmod (cinner ψ (A φ)) / (norm ψ * norm φ))›
proof (unfold onorm_def, rule cSup_eq_cSup)
show ‹bdd_above (range (λx. norm (A x) / norm x))›
by (meson assms bdd_aboveI2 le_onorm)
next
fix a
assume ‹a ∈ range (λφ. norm (A φ) / norm φ)›
then obtain φ where ‹a = norm (A φ) / norm φ›
by auto
then have ‹a ≤ cmod (cinner (A φ) (A φ)) / (norm (A φ) * norm φ)›
apply auto
by (smt (verit) divide_divide_eq_left norm_eq_sqrt_cinner norm_imp_pos_and_ge real_div_sqrt)
then show ‹∃b∈range (λ(ψ, φ). cmod (cinner ψ (A φ)) / (norm ψ * norm φ)). a ≤ b›
by force
next
fix b
assume ‹b ∈ range (λ(ψ, φ). cmod (cinner ψ (A φ)) / (norm ψ * norm φ))›
then obtain ψ φ where b: ‹b = cmod (cinner ψ (A φ)) / (norm ψ * norm φ)›
by auto
then have ‹b ≤ norm (A φ) / norm φ›
apply auto
by (smt (verit, ccfv_threshold) complex_inner_class.Cauchy_Schwarz_ineq2 division_ring_divide_zero linordered_field_class.divide_right_mono mult_cancel_left1 nonzero_mult_divide_mult_cancel_left2 norm_imp_pos_and_ge ordered_field_class.sign_simps(33) zero_le_divide_iff)
then show ‹∃a∈range (λx. norm (A x) / norm x). b ≤ a›
by auto
qed
subsection ‹Orthogonality›
definition "orthogonal_complement S = {x| x. ∀y∈S. cinner x y = 0}"
lemma orthogonal_complement_orthoI:
‹x ∈ orthogonal_complement M ⟹ y ∈ M ⟹ ⟨ x, y ⟩ = 0›
unfolding orthogonal_complement_def by auto
lemma orthogonal_complement_orthoI':
‹x ∈ M ⟹ y ∈ orthogonal_complement M ⟹ ⟨ x, y ⟩ = 0›
by (metis cinner_commute' complex_cnj_zero orthogonal_complement_orthoI)
lemma orthogonal_complementI:
‹(⋀x. x ∈ M ⟹ ⟨ y, x ⟩ = 0) ⟹ y ∈ orthogonal_complement M›
unfolding orthogonal_complement_def
by simp
abbreviation is_orthogonal::‹'a::complex_inner ⇒ 'a ⇒ bool› where
‹is_orthogonal x y ≡ ⟨ x, y ⟩ = 0›
bundle orthogonal_notation begin
notation is_orthogonal (infixl "⊥" 69)
end
bundle no_orthogonal_notation begin
no_notation is_orthogonal (infixl "⊥" 69)
end
lemma is_orthogonal_sym: "is_orthogonal ψ φ = is_orthogonal φ ψ"
by (metis cinner_commute' complex_cnj_zero)
lemma orthogonal_complement_closed_subspace[simp]:
"closed_csubspace (orthogonal_complement A)"
for A :: ‹('a::complex_inner) set›
proof (intro closed_csubspace.intro complex_vector.subspaceI)
fix x y and c
show ‹0 ∈ orthogonal_complement A›
by (rule orthogonal_complementI, simp)
show ‹x + y ∈ orthogonal_complement A›
if ‹x ∈ orthogonal_complement A› and ‹y ∈ orthogonal_complement A›
using that by (auto intro!: orthogonal_complementI dest!: orthogonal_complement_orthoI
simp add: cinner_add_left)
show ‹c *⇩C x ∈ orthogonal_complement A› if ‹x ∈ orthogonal_complement A›
using that by (auto intro!: orthogonal_complementI dest!: orthogonal_complement_orthoI)
show "closed (orthogonal_complement A)"
proof (auto simp add: closed_sequential_limits, rename_tac an a)
fix an a
assume ortho: ‹∀n::nat. an n ∈ orthogonal_complement A›
assume lim: ‹an ⇢ a›
have ‹∀ y ∈ A. ∀ n. ⟨ y , an n ⟩ = 0›
using orthogonal_complement_orthoI'
by (simp add: orthogonal_complement_orthoI' ortho)
moreover have ‹isCont (λ x. ⟨ y , x ⟩) a› for y
using bounded_clinear_cinner_right clinear_continuous_at
by (simp add: clinear_continuous_at bounded_clinear_cinner_right)
ultimately have ‹(λ n. (λ v. ⟨ y , v ⟩) (an n)) ⇢ (λ v. ⟨ y , v ⟩) a› for y
using isCont_tendsto_compose
by (simp add: isCont_tendsto_compose lim)
hence ‹∀ y∈A. (λ n. ⟨ y , an n ⟩ ) ⇢ ⟨ y , a ⟩›
by simp
hence ‹∀ y∈A. (λ n. 0 ) ⇢ ⟨ y , a ⟩›
using ‹∀ y ∈ A. ∀ n. ⟨ y , an n ⟩ = 0›
by fastforce
hence ‹∀ y ∈ A. ⟨ y , a ⟩ = 0›
using limI by fastforce
then show ‹a ∈ orthogonal_complement A›
by (simp add: orthogonal_complementI is_orthogonal_sym)
qed
qed
lemma orthogonal_complement_zero_intersection:
assumes "0∈M"
shows ‹M ∩ (orthogonal_complement M) = {0}›
proof -
have "x=0" if "x∈M" and "x∈orthogonal_complement M" for x
proof -
from that have "⟨ x, x ⟩ = 0"
unfolding orthogonal_complement_def by auto
thus "x=0"
by auto
qed
with assms show ?thesis
unfolding orthogonal_complement_def by auto
qed
lemma is_orthogonal_closure_cspan:
assumes "⋀x y. x ∈ X ⟹ y ∈ Y ⟹ is_orthogonal x y"
assumes ‹x ∈ closure (cspan X)› ‹y ∈ closure (cspan Y)›
shows "is_orthogonal x y"
proof -
have *: ‹cinner x y = 0› if ‹y ∈ Y› for y
using bounded_antilinear_cinner_left apply (rule bounded_antilinear_eq_on[where G=X])
using assms that by auto
show ‹cinner x y = 0›
using bounded_clinear_cinner_right apply (rule bounded_clinear_eq_on[where G=Y])
using * assms by auto
qed
instantiation ccsubspace :: (complex_inner) "uminus"
begin
lift_definition uminus_ccsubspace::‹'a ccsubspace ⇒ 'a ccsubspace›
is ‹orthogonal_complement›
by simp
instance ..
end
instantiation ccsubspace :: (complex_inner) minus begin
lift_definition minus_ccsubspace :: "'a ccsubspace ⇒ 'a ccsubspace ⇒ 'a ccsubspace"
is "λA B. A ∩ (orthogonal_complement B)"
by simp
instance..
end
text ‹Orthogonal set›
definition is_ortho_set :: "'a::complex_inner set ⇒ bool" where
‹is_ortho_set S = ((∀x∈S. ∀y∈S. x ≠ y ⟶ ⟨x, y⟩ = 0) ∧ 0 ∉ S)›
lemma is_ortho_set_empty[simp]: "is_ortho_set {}"
unfolding is_ortho_set_def by auto
lemma is_ortho_set_antimono: ‹A ⊆ B ⟹ is_ortho_set B ⟹ is_ortho_set A›
unfolding is_ortho_set_def by auto
lemma orthogonal_complement_of_closure:
fixes A ::"('a::complex_inner) set"
shows "orthogonal_complement A = orthogonal_complement (closure A)"
proof-
have s1: ‹⟨ y, x ⟩ = 0›
if a1: "x ∈ (orthogonal_complement A)"
and a2: ‹y ∈ closure A›
for x y
proof-
have ‹∀ y ∈ A. ⟨ y , x ⟩ = 0›
by (simp add: a1 orthogonal_complement_orthoI')
then obtain yy where ‹∀ n. yy n ∈ A› and ‹yy ⇢ y›
using a2 closure_sequential by blast
have ‹isCont (λ t. ⟨ t , x ⟩) y›
by simp
hence ‹(λ n. ⟨ yy n , x ⟩) ⇢ ⟨ y , x ⟩›
using ‹yy ⇢ y› isCont_tendsto_compose
by fastforce
hence ‹(λ n. 0) ⇢ ⟨ y , x ⟩›
using ‹∀ y ∈ A. ⟨ y , x ⟩ = 0› ‹∀ n. yy n ∈ A› by simp
thus ?thesis
using limI by force
qed
hence "x ∈ orthogonal_complement (closure A)"
if a1: "x ∈ (orthogonal_complement A)"
for x
using that
by (meson orthogonal_complementI is_orthogonal_sym)
moreover have ‹x ∈ (orthogonal_complement A)›
if "x ∈ (orthogonal_complement (closure A))"
for x
using that
by (meson closure_subset orthogonal_complement_orthoI orthogonal_complementI subset_eq)
ultimately show ?thesis by blast
qed
lemma is_orthogonal_closure:
assumes ‹⋀s. s ∈ S ⟹ is_orthogonal a s›
assumes ‹x ∈ closure S›
shows ‹is_orthogonal a x›
by (metis assms(1) assms(2) orthogonal_complementI orthogonal_complement_of_closure orthogonal_complement_orthoI)
lemma is_orthogonal_cspan:
assumes a1: "⋀s. s ∈ S ⟹ is_orthogonal a s" and a3: "x ∈ cspan S"
shows "⟨a, x⟩ = 0"
proof-
have "∃t r. finite t ∧ t ⊆ S ∧ (∑a∈t. r a *⇩C a) = x"
using complex_vector.span_explicit
by (smt a3 mem_Collect_eq)
then obtain t r where b1: "finite t" and b2: "t ⊆ S" and b3: "(∑a∈t. r a *⇩C a) = x"
by blast
have x1: "⟨a, i⟩ = 0"
if "i∈t" for i
using b2 a1 that by blast
have "⟨a, x⟩ = ⟨a, (∑i∈t. r i *⇩C i)⟩"
by (simp add: b3)
also have "… = (∑i∈t. r i *⇩C ⟨a, i⟩)"
by (simp add: cinner_sum_right)
also have "… = 0"
using x1 by simp
finally show ?thesis.
qed
lemma ccspan_leq_ortho_ccspan:
assumes "⋀s t. s∈S ⟹ t∈T ⟹ is_orthogonal s t"
shows "ccspan S ≤ - (ccspan T)"
using assms apply transfer
by (smt (verit, ccfv_threshold) is_orthogonal_closure is_orthogonal_cspan is_orthogonal_sym orthogonal_complementI subsetI)
lemma double_orthogonal_complement_increasing[simp]:
shows "M ⊆ orthogonal_complement (orthogonal_complement M)"
proof (rule subsetI)
fix x assume s1: "x ∈ M"
have ‹∀ y ∈ (orthogonal_complement M). ⟨ x, y ⟩ = 0›
using s1 orthogonal_complement_orthoI' by auto
hence ‹x ∈ orthogonal_complement (orthogonal_complement M)›
by (simp add: orthogonal_complement_def)
then show "x ∈ orthogonal_complement (orthogonal_complement M)"
by blast
qed
lemma orthonormal_basis_of_cspan:
fixes S::"'a::complex_inner set"
assumes "finite S"
shows "∃A. is_ortho_set A ∧ (∀x∈A. norm x = 1) ∧ cspan A = cspan S ∧ finite A"
proof (use assms in induction)
case empty
show ?case
apply (rule exI[of _ "{}"])
by auto
next
case (insert s S)
from insert.IH
obtain A where orthoA: "is_ortho_set A" and normA: "⋀x. x∈A ⟹ norm x = 1" and spanA: "cspan A = cspan S" and finiteA: "finite A"
by auto
show ?case
proof (cases ‹s ∈ cspan S›)
case True
then have ‹cspan (insert s S) = cspan S›
by (simp add: complex_vector.span_redundant)
with orthoA normA spanA finiteA
show ?thesis
by auto
next
case False
obtain a where a_ortho: ‹⋀x. x∈A ⟹ is_orthogonal x a› and sa_span: ‹s - a ∈ cspan A›
proof (atomize_elim, use ‹finite A› ‹is_ortho_set A› in induction)
case empty
then show ?case
by auto
next
case (insert x A)
then obtain a where orthoA: ‹⋀x. x ∈ A ⟹ is_orthogonal x a› and sa: ‹s - a ∈ cspan A›
by (meson is_ortho_set_antimono subset_insertI)
define a' where ‹a' = a - cinner x a *⇩C inverse (cinner x x) *⇩C x›
have ‹is_orthogonal x a'›
unfolding a'_def cinner_diff_right cinner_scaleC_right
apply (cases ‹cinner x x = 0›)
by auto
have orthoA: ‹is_orthogonal y a'› if ‹y ∈ A› for y
unfolding a'_def cinner_diff_right cinner_scaleC_right
apply auto by (metis insert.prems insertCI is_ortho_set_def mult_not_zero orthoA that)
have ‹s - a' ∈ cspan (insert x A)›
unfolding a'_def apply auto
by (metis (no_types, lifting) complex_vector.span_breakdown_eq diff_add_cancel diff_diff_add sa)
with ‹is_orthogonal x a'› orthoA
show ?case
apply (rule_tac exI[of _ a'])
by auto
qed
from False sa_span
have ‹a ≠ 0›
unfolding spanA by auto
define a' where ‹a' = inverse (norm a) *⇩C a›
with ‹a ≠ 0› have ‹norm a' = 1›
by (simp add: norm_inverse)
have a: ‹a = norm a *⇩C a'›
by (simp add: ‹a ≠ 0› a'_def)
from sa_span spanA
have a'_span: ‹a' ∈ cspan (insert s S)›
unfolding a'_def
by (metis complex_vector.eq_span_insert_eq complex_vector.span_scale complex_vector.span_superset in_mono insertI1)
from sa_span
have s_span: ‹s ∈ cspan (insert a' A)›
apply (subst (asm) a)
using complex_vector.span_breakdown_eq by blast
from ‹a ≠ 0› a_ortho orthoA
have ortho: "is_ortho_set (insert a' A)"
unfolding is_ortho_set_def a'_def
apply auto
by (meson is_orthogonal_sym)
have span: ‹cspan (insert a' A) = cspan (insert s S)›
using a'_span s_span spanA apply auto
apply (metis (full_types) complex_vector.span_breakdown_eq complex_vector.span_redundant insert_commute s_span)
by (metis (full_types) complex_vector.span_breakdown_eq complex_vector.span_redundant insert_commute s_span)
show ?thesis
apply (rule exI[of _ ‹insert a' A›])
by (simp add: ortho ‹norm a' = 1› normA finiteA span)
qed
qed
lemma is_ortho_set_cindependent:
assumes "is_ortho_set A"
shows "cindependent A"
proof -
have "u v = 0"
if b1: "finite t" and b2: "t ⊆ A" and b3: "(∑v∈t. u v *⇩C v) = 0" and b4: "v ∈ t"
for t u v
proof -
have "⟨v, v'⟩ = 0" if c1: "v'∈t-{v}" for v'
by (metis DiffE assms b2 b4 insertI1 is_ortho_set_antimono is_ortho_set_def that)
hence sum0: "(∑v'∈t-{v}. u v' * ⟨v, v'⟩) = 0"
by simp
have "⟨v, (∑v'∈t. u v' *⇩C v')⟩ = (∑v'∈t. u v' * ⟨v, v'⟩)"
using b1
by (metis (mono_tags, lifting) cinner_scaleC_right cinner_sum_right sum.cong)
also have "… = u v * ⟨v, v⟩ + (∑v'∈t-{v}. u v' * ⟨v, v'⟩)"
by (meson b1 b4 sum.remove)
also have "… = u v * ⟨v, v⟩"
using sum0 by simp
finally have "⟨v, (∑v'∈t. u v' *⇩C v')⟩ = u v * ⟨v, v⟩"
by blast
hence "u v * ⟨v, v⟩ = 0" using b3 by simp
moreover have "⟨v, v⟩ ≠ 0"
using assms is_ortho_set_def b2 b4 by auto
ultimately show "u v = 0" by simp
qed
thus ?thesis using complex_vector.independent_explicit_module
by (smt cdependent_raw_def)
qed
lemma onb_expansion_finite:
includes notation_norm
fixes T::‹'a::{complex_inner,cfinite_dim} set›
assumes a1: ‹cspan T = UNIV› and a3: ‹is_ortho_set T›
and a4: ‹⋀t. t∈T ⟹ ∥t∥ = 1›
shows ‹x = (∑t∈T. ⟨ t, x ⟩ *⇩C t)›
proof -
have ‹finite T›
apply (rule cindependent_cfinite_dim_finite)
by (simp add: a3 is_ortho_set_cindependent)
have ‹closure (complex_vector.span T) = complex_vector.span T›
by (simp add: a1)
have ‹{∑a∈t. r a *⇩C a |t r. finite t ∧ t ⊆ T} = {∑a∈T. r a *⇩C a |r. True}›
apply auto
apply (rule_tac x=‹λa. if a ∈ t then r a else 0› in exI)
apply (simp add: ‹finite T› sum.mono_neutral_cong_right)
using ‹finite T› by blast
have f1: "∀A. {a. ∃Aa f. (a::'a) = (∑a∈Aa. f a *⇩C a) ∧ finite Aa ∧ Aa ⊆ A} = cspan A"
by (simp add: complex_vector.span_explicit)
have f2: "∀a. (∃f. a = (∑a∈T. f a *⇩C a)) ∨ (∀A. (∀f. a ≠ (∑a∈A. f a *⇩C a)) ∨ infinite A ∨ ¬ A ⊆ T)"
using ‹{∑a∈t. r a *⇩C a |t r. finite t ∧ t ⊆ T} = {∑a∈T. r a *⇩C a |r. True}› by auto
have f3: "∀A a. (∃Aa f. (a::'a) = (∑a∈Aa. f a *⇩C a) ∧ finite Aa ∧ Aa ⊆ A) ∨ a ∉ cspan A"
using f1 by blast
have "cspan T = UNIV"
by (metis (full_types, lifting) ‹complex_vector.span T = UNIV›)
hence ‹∃ r. x = (∑ a∈T. r a *⇩C a)›
using f3 f2 by blast
then obtain r where ‹x = (∑ a∈T. r a *⇩C a)›
by blast
have ‹r a = ⟨a, x⟩› if ‹a ∈ T› for a
proof-
have ‹norm a = 1›
using a4
by (simp add: ‹a ∈ T›)
moreover have ‹norm a = sqrt (norm ⟨a, a⟩)›
using norm_eq_sqrt_cinner by auto
ultimately have ‹sqrt (norm ⟨a, a⟩) = 1›
by simp
hence ‹norm ⟨a, a⟩ = 1›
using real_sqrt_eq_1_iff by blast
moreover have ‹⟨a, a⟩ ∈ ℝ›
by (simp add: cinner_real)
moreover have ‹⟨a, a⟩ ≥ 0›
using cinner_ge_zero by blast
ultimately have w1: ‹⟨a, a⟩ = 1›
by (metis ‹0 ≤ ⟨a, a⟩› ‹cmod ⟨a, a⟩ = 1› complex_of_real_cmod of_real_1)
have ‹r t * ⟨a, t⟩ = 0› if ‹t ∈ T-{a}› for t
by (metis DiffD1 DiffD2 ‹a ∈ T› a3 is_ortho_set_def mult_eq_0_iff singletonI that)
hence s1: ‹(∑ t∈T-{a}. r t * ⟨a, t⟩) = 0›
by (simp add: ‹⋀t. t ∈ T - {a} ⟹ r t * ⟨a, t⟩ = 0›)
have ‹⟨a, x⟩ = ⟨a, (∑ t∈T. r t *⇩C t)⟩›
using ‹x = (∑ a∈T. r a *⇩C a)›
by simp
also have ‹… = (∑ t∈T. ⟨a, r t *⇩C t⟩)›
using cinner_sum_right by blast
also have ‹… = (∑ t∈T. r t * ⟨a, t⟩)›
by simp
also have ‹… = r a * ⟨a, a⟩ + (∑ t∈T-{a}. r t * ⟨a, t⟩)›
using ‹a ∈ T›
by (meson ‹finite T› sum.remove)
also have ‹… = r a * ⟨a, a⟩›
using s1
by simp
also have ‹… = r a›
by (simp add: w1)
finally show ?thesis by auto
qed
thus ?thesis
using ‹x = (∑ a∈T. r a *⇩C a)›
by fastforce
qed
subsection ‹Projections›
lemma smallest_norm_exists:
includes notation_norm
fixes M :: ‹'a::chilbert_space set›
assumes q1: ‹convex M› and q2: ‹closed M› and q3: ‹M ≠ {}›
shows ‹∃k. is_arg_min (λ x. ∥x∥) (λ t. t ∈ M) k›
proof-
define d where ‹d = Inf { ∥x∥^2 | x. x ∈ M }›
have w4: ‹{ ∥x∥^2 | x. x ∈ M } ≠ {}›
by (simp add: assms(3))
have ‹∀ x. ∥x∥^2 ≥ 0›
by simp
hence bdd_below1: ‹bdd_below { ∥x∥^2 | x. x ∈ M }›
by fastforce
have ‹d ≤ ∥x∥^2›
if a1: "x ∈ M"
for x
proof-
have "∀v. (∃w. Re (⟨v , v⟩ ) = ∥w∥⇧2 ∧ w ∈ M) ∨ v ∉ M"
by (metis (no_types) power2_norm_eq_cinner')
hence "Re (⟨x , x⟩ ) ∈ {∥v∥⇧2 |v. v ∈ M}"
using a1 by blast
thus ?thesis
unfolding d_def
by (metis (lifting) bdd_below1 cInf_lower power2_norm_eq_cinner')
qed
have ‹∀ ε > 0. ∃ t ∈ { ∥x∥^2 | x. x ∈ M }. t < d + ε›
unfolding d_def
using w4 bdd_below1
by (meson cInf_lessD less_add_same_cancel1)
hence ‹∀ ε > 0. ∃ x ∈ M. ∥x∥^2 < d + ε›
by auto
hence ‹∀ ε > 0. ∃ x ∈ M. ∥x∥^2 < d + ε›
by (simp add: ‹⋀x. x ∈ M ⟹ d ≤ ∥x∥⇧2›)
hence w1: ‹∀ n::nat. ∃ x ∈ M. ∥x∥^2 < d + 1/(n+1)› by auto
then obtain r::‹nat ⇒ 'a› where w2: ‹∀ n. r n ∈ M ∧ ∥ r n ∥^2 < d + 1/(n+1)›
by metis
have w3: ‹∀ n. r n ∈ M›
by (simp add: w2)
have ‹∀ n. ∥ r n ∥^2 < d + 1/(n+1)›
by (simp add: w2)
have w5: ‹∥ (r n) - (r m) ∥^2 < 2*(1/(n+1) + 1/(m+1))›
for m n
proof-
have w6: ‹∥ r n ∥^2 < d + 1/(n+1)›
by (metis w2 of_nat_1 of_nat_add)
have ‹ ∥ r m ∥^2 < d + 1/(m+1)›
by (metis w2 of_nat_1 of_nat_add)
have ‹(r n) ∈ M›
by (simp add: ‹∀n. r n ∈ M›)
moreover have ‹(r m) ∈ M›
by (simp add: ‹∀n. r n ∈ M›)
ultimately have ‹(1/2) *⇩R (r n) + (1/2) *⇩R (r m) ∈ M›
using ‹convex M›
by (simp add: convexD)
hence ‹∥ (1/2) *⇩R (r n) + (1/2) *⇩R (r m) ∥^2 ≥ d›
by (simp add: ‹⋀x. x ∈ M ⟹ d ≤ ∥x∥⇧2›)
have ‹∥ (1/2) *⇩R (r n) - (1/2) *⇩R (r m) ∥^2
= (1/2)*( ∥ r n ∥^2 + ∥ r m ∥^2 ) - ∥ (1/2) *⇩R (r n) + (1/2) *⇩R (r m) ∥^2›
by (smt (z3) div_by_1 field_sum_of_halves nonzero_mult_div_cancel_left parallelogram_law polar_identity power2_norm_eq_cinner' scaleR_collapse times_divide_eq_left)
also have ‹...
< (1/2)*( d + 1/(n+1) + ∥ r m ∥^2 ) - ∥ (1/2) *⇩R (r n) + (1/2) *⇩R (r m) ∥^2›
using ‹∥r n∥⇧2 < d + 1 / real (n + 1)› by auto
also have ‹...
< (1/2)*( d + 1/(n+1) + d + 1/(m+1) ) - ∥ (1/2) *⇩R (r n) + (1/2) *⇩R (r m) ∥^2›
using ‹∥r m∥⇧2 < d + 1 / real (m + 1)› by auto
also have ‹...
≤ (1/2)*( d + 1/(n+1) + d + 1/(m+1) ) - d›
by (simp add: ‹d ≤ ∥(1 / 2) *⇩R r n + (1 / 2) *⇩R r m∥⇧2›)
also have ‹...
≤ (1/2)*( 1/(n+1) + 1/(m+1) + 2*d ) - d›
by simp
also have ‹...
≤ (1/2)*( 1/(n+1) + 1/(m+1) ) + (1/2)*(2*d) - d›
by (simp add: distrib_left)
also have ‹...
≤ (1/2)*( 1/(n+1) + 1/(m+1) ) + d - d›
by simp
also have ‹...
≤ (1/2)*( 1/(n+1) + 1/(m+1) )›
by simp
finally have ‹ ∥(1 / 2) *⇩R r n - (1 / 2) *⇩R r m∥⇧2 < 1 / 2 * (1 / real (n + 1) + 1 / real (m + 1)) ›
by blast
hence ‹ ∥(1 / 2) *⇩R (r n - r m) ∥⇧2 < (1 / 2) * (1 / real (n + 1) + 1 / real (m + 1)) ›
by (simp add: real_vector.scale_right_diff_distrib)
hence ‹ ((1 / 2)*∥ (r n - r m) ∥)⇧2 < (1 / 2) * (1 / real (n + 1) + 1 / real (m + 1)) ›
by simp
hence ‹ (1 / 2)^2*(∥ (r n - r m) ∥)⇧2 < (1 / 2) * (1 / real (n + 1) + 1 / real (m + 1)) ›
by (metis power_mult_distrib)
hence ‹ (1 / 4) *(∥ (r n - r m) ∥)⇧2 < (1 / 2) * (1 / real (n + 1) + 1 / real (m + 1)) ›
by (simp add: power_divide)
hence ‹ ∥ (r n - r m) ∥⇧2 < 2 * (1 / real (n + 1) + 1 / real (m + 1)) ›
by simp
thus ?thesis
by (metis of_nat_1 of_nat_add)
qed
hence "∃ N. ∀ n m. n ≥ N ∧ m ≥ N ⟶ ∥ (r n) - (r m) ∥^2 < ε^2"
if "ε > 0"
for ε
proof-
obtain N::nat where ‹1/(N + 1) < ε^2/4›
using LIMSEQ_ignore_initial_segment[OF lim_inverse_n', where k=1]
by (metis Suc_eq_plus1 ‹0 < ε› nat_approx_posE zero_less_divide_iff zero_less_numeral
zero_less_power )
hence ‹4/(N + 1) < ε^2›
by simp
have "2*(1/(n+1) + 1/(m+1)) < ε^2"
if f1: "n ≥ N" and f2: "m ≥ N"
for m n::nat
proof-
have ‹1/(n+1) ≤ 1/(N+1)›
by (simp add: f1 linordered_field_class.frac_le)
moreover have ‹1/(m+1) ≤ 1/(N+1)›
by (simp add: f2 linordered_field_class.frac_le)
ultimately have ‹2*(1/(n+1) + 1/(m+1)) ≤ 4/(N+1)›
by simp
thus ?thesis using ‹4/(N + 1) < ε^2›
by linarith
qed
hence "∥ (r n) - (r m) ∥^2 < ε^2"
if y1: "n ≥ N" and y2: "m ≥ N"
for m n::nat
using that
by (smt ‹⋀n m. ∥r n - r m∥⇧2 < 2 * (1 / (real n + 1) + 1 / (real m + 1))› of_nat_1 of_nat_add)
thus ?thesis
by blast
qed
hence ‹∀ ε > 0. ∃ N::nat. ∀ n m::nat. n ≥ N ∧ m ≥ N ⟶ ∥ (r n) - (r m) ∥^2 < ε^2›
by blast
hence ‹∀ ε > 0. ∃ N::nat. ∀ n m::nat. n ≥ N ∧ m ≥ N ⟶ ∥ (r n) - (r m) ∥ < ε›
by (meson less_eq_real_def power_less_imp_less_base)
hence ‹Cauchy r›
using CauchyI by fastforce
then obtain k where ‹r ⇢ k›
using convergent_eq_Cauchy by auto
have ‹k ∈ M› using ‹closed M›
using ‹∀n. r n ∈ M› ‹r ⇢ k› closed_sequentially by auto
have ‹(λ n. ∥ r n ∥^2) ⇢ ∥ k ∥^2›
by (simp add: ‹r ⇢ k› tendsto_norm tendsto_power)
moreover have ‹(λ n. ∥ r n ∥^2) ⇢ d›
proof-
have ‹¦∥ r n ∥^2 - d¦ < 1/(n+1)› for n :: nat
using ‹⋀x. x ∈ M ⟹ d ≤ ∥x∥⇧2› ‹∀n. r n ∈ M ∧ ∥r n∥⇧2 < d + 1 / (real n + 1)› of_nat_1 of_nat_add
by smt
moreover have ‹(λn. 1 / real (n + 1)) ⇢ 0›
using LIMSEQ_ignore_initial_segment[OF lim_inverse_n', where k=1] by blast
ultimately have ‹(λ n. ¦∥ r n ∥^2 - d¦ ) ⇢ 0›
by (simp add: LIMSEQ_norm_0)
hence ‹(λ n. ∥ r n ∥^2 - d ) ⇢ 0›
by (simp add: tendsto_rabs_zero_iff)
moreover have ‹(λ n. d ) ⇢ d›
by simp
ultimately have ‹(λ n. (∥ r n ∥^2 - d)+d ) ⇢ 0+d›
using tendsto_add by fastforce
thus ?thesis by simp
qed
ultimately have ‹d = ∥ k ∥^2›
using LIMSEQ_unique by auto
hence ‹t ∈ M ⟹ ∥ k ∥^2 ≤ ∥ t ∥^2› for t
using ‹⋀x. x ∈ M ⟹ d ≤ ∥x∥⇧2› by auto
hence q1: ‹∃ k. is_arg_min (λ x. ∥x∥^2) (λ t. t ∈ M) k›
using ‹k ∈ M›
is_arg_min_def ‹d = ∥k∥⇧2›
by smt
thus ‹∃ k. is_arg_min (λ x. ∥x∥) (λ t. t ∈ M) k›
by (smt is_arg_min_def norm_ge_zero power2_eq_square power2_le_imp_le)
qed
lemma smallest_norm_unique:
includes notation_norm
fixes M :: ‹'a::complex_inner set›
assumes q1: ‹convex M›
assumes r: ‹is_arg_min (λ x. ∥x∥) (λ t. t ∈ M) r›
assumes s: ‹is_arg_min (λ x. ∥x∥) (λ t. t ∈ M) s›
shows ‹r = s›
proof -
have ‹r ∈ M›
using ‹is_arg_min (λx. ∥x∥) (λ t. t ∈ M) r›
by (simp add: is_arg_min_def)
moreover have ‹s ∈ M›
using ‹is_arg_min (λx. ∥x∥) (λ t. t ∈ M) s›
by (simp add: is_arg_min_def)
ultimately have ‹((1/2) *⇩R r + (1/2) *⇩R s) ∈ M› using ‹convex M›
by (simp add: convexD)
hence ‹∥r∥ ≤ ∥ (1/2) *⇩R r + (1/2) *⇩R s ∥›
by (metis is_arg_min_linorder r)
hence u2: ‹∥r∥^2 ≤ ∥ (1/2) *⇩R r + (1/2) *⇩R s ∥^2›
using norm_ge_zero power_mono by blast
have ‹∥r∥ ≤ ∥s∥›
using r s is_arg_min_def
by (metis is_arg_min_linorder)
moreover have ‹∥s∥ ≤ ∥r∥›
using r s is_arg_min_def
by (metis is_arg_min_linorder)
ultimately have u3: ‹∥r∥ = ∥s∥› by simp
have ‹∥ (1/2) *⇩R r - (1/2) *⇩R s ∥^2 ≤ 0›
using u2 u3 parallelogram_law
by (smt (verit, ccfv_SIG) polar_identity_minus power2_norm_eq_cinner' scaleR_add_right scaleR_half_double)
hence ‹∥ (1/2) *⇩R r - (1/2) *⇩R s ∥^2 = 0›
by simp
hence ‹∥ (1/2) *⇩R r - (1/2) *⇩R s ∥ = 0›
by auto
hence ‹(1/2) *⇩R r - (1/2) *⇩R s = 0›
using norm_eq_zero by blast
thus ?thesis by simp
qed
theorem smallest_dist_exists:
fixes M::‹'a::chilbert_space set› and h
assumes a1: ‹convex M› and a2: ‹closed M› and a3: ‹M ≠ {}›
shows ‹∃k. is_arg_min (λ x. dist x h) (λ x. x ∈ M) k›
proof-
have *: "is_arg_min (λx. dist x h) (λx. x∈M) (k+h) ⟷ is_arg_min (λx. norm x) (λx. x∈(λx. x-h) ` M) k" for k
unfolding dist_norm is_arg_min_def apply auto using add_implies_diff by blast
have ‹∃k. is_arg_min (λx. dist x h) (λx. x∈M) (k+h)›
apply (subst *)
apply (rule smallest_norm_exists)
using assms by (auto simp: closed_translation_subtract)
then show ‹∃k. is_arg_min (λ x. dist x h) (λ x. x ∈ M) k›
by metis
qed
theorem smallest_dist_unique:
fixes M::‹'a::complex_inner set› and h
assumes a1: ‹convex M›
assumes ‹is_arg_min (λ x. dist x h) (λ x. x ∈ M) r›
assumes ‹is_arg_min (λ x. dist x h) (λ x. x ∈ M) s›
shows ‹r = s›
proof-
have *: "is_arg_min (λx. dist x h) (λx. x∈M) k ⟷ is_arg_min (λx. norm x) (λx. x∈(λx. x-h) ` M) (k-h)" for k
unfolding dist_norm is_arg_min_def by auto
have ‹r - h = s - h›
using _ assms(2,3)[unfolded *] apply (rule smallest_norm_unique)
by (simp add: a1)
thus ‹r = s›
by auto
qed
theorem smallest_dist_is_ortho:
fixes M::‹'a::complex_inner set› and h k::'a
assumes b1: ‹closed_csubspace M›
shows ‹(is_arg_min (λ x. dist x h) (λ x. x ∈ M) k) ⟷
h - k ∈ (orthogonal_complement M) ∧ k ∈ M›
proof-
include notation_norm
have ‹csubspace M›
using ‹closed_csubspace M› unfolding closed_csubspace_def by blast
have r1: ‹2 * Re (⟨ h - k , f ⟩) ≤ ∥ f ∥^2›
if "f ∈ M" and ‹k ∈ M› and ‹is_arg_min (λx. dist x h) (λ x. x ∈ M) k›
for f
proof-
have ‹k + f ∈ M›
using ‹csubspace M›
by (simp add:complex_vector.subspace_add that)
have "∀f A a b. ¬ is_arg_min f (λ x. x ∈ A) (a::'a) ∨ (f a::real) ≤ f b ∨ b ∉ A"
by (metis (no_types) is_arg_min_linorder)
hence "dist k h ≤ dist (f + k) h"
by (metis ‹is_arg_min (λx. dist x h) (λ x. x ∈ M) k› ‹k + f ∈ M› add.commute)
hence ‹dist h k ≤ dist h (k + f)›
by (simp add: add.commute dist_commute)
hence ‹∥ h - k ∥ ≤ ∥ h - (k + f) ∥›
by (simp add: dist_norm)
hence ‹∥ h - k ∥^2 ≤ ∥ h - (k + f) ∥^2›
by (simp add: power_mono)
also have ‹... ≤ ∥ (h - k) - f ∥^2›
by (simp add: diff_diff_add)
also have ‹... ≤ ∥ (h - k) ∥^2 + ∥ f ∥^2 - 2 * Re (⟨ h - k , f ⟩)›
by (simp add: polar_identity_minus)
finally have ‹∥ (h - k) ∥^2 ≤ ∥ (h - k) ∥^2 + ∥ f ∥^2 - 2 * Re (⟨ h - k , f ⟩)›
by simp
thus ?thesis by simp
qed
have q4: ‹∀ c > 0. 2 * Re (⟨ h - k , f ⟩) ≤ c›
if ‹∀c>0. 2 * Re (⟨h - k , f⟩ ) ≤ c * ∥f∥⇧2›
for f
proof (cases ‹∥ f ∥^2 > 0›)
case True
hence ‹∀ c > 0. 2 * Re (⟨ h - k , f ⟩) ≤ (c/∥ f ∥^2)*∥ f ∥^2›
using that linordered_field_class.divide_pos_pos by blast
thus ?thesis
using True by auto
next
case False
hence ‹∥ f ∥^2 = 0›
by simp
thus ?thesis
by auto
qed
have q3: ‹∀ c::real. c > 0 ⟶ 2 * Re (⟨ h - k , f ⟩) ≤ 0›
if a3: ‹∀f. f ∈ M ⟶ (∀c>0. 2 * Re ⟨h - k , f⟩ ≤ c * ∥f∥⇧2)›
and a2: "f ∈ M"
and a1: "is_arg_min (λ x. dist x h) (λ x. x ∈ M) k"
for f
proof-
have ‹∀ c > 0. 2 * Re (⟨ h - k , f ⟩) ≤ c*∥ f ∥^2›
by (simp add: that )
thus ?thesis
using q4 by smt
qed
have w2: "h - k ∈ orthogonal_complement M ∧ k ∈ M"
if a1: "is_arg_min (λ x. dist x h) (λ x. x ∈ M) k"
proof-
have ‹k ∈ M›
using is_arg_min_def that by fastforce
hence ‹∀ f. f ∈ M ⟶ 2 * Re (⟨ h - k , f ⟩) ≤ ∥ f ∥^2›
using r1
by (simp add: that)
have ‹∀ f. f ∈ M ⟶
(∀ c::real. 2 * Re (⟨ h - k , c *⇩R f ⟩) ≤ ∥ c *⇩R f ∥^2)›
using assms scaleR_scaleC complex_vector.subspace_def ‹csubspace M›
by (metis ‹∀f. f ∈ M ⟶ 2 * Re ⟨h - k, f⟩ ≤ ∥f∥⇧2›)
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c * (2 * Re (⟨ h - k , f ⟩)) ≤ ∥ c *⇩R f ∥^2)›
by (metis Re_complex_of_real cinner_scaleC_right complex_add_cnj complex_cnj_complex_of_real
complex_cnj_mult of_real_mult scaleR_scaleC semiring_normalization_rules(34))
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c * (2 * Re (⟨ h - k , f ⟩)) ≤ ¦c¦^2*∥ f ∥^2)›
by (simp add: power_mult_distrib)
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c * (2 * Re (⟨ h - k , f ⟩)) ≤ c^2*∥ f ∥^2)›
by auto
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ c * (2 * Re (⟨ h - k , f ⟩)) ≤ c^2*∥ f ∥^2)›
by simp
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ c*(2 * Re (⟨ h - k , f ⟩)) ≤ c*(c*∥ f ∥^2))›
by (simp add: power2_eq_square)
hence q4: ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ 2 * Re (⟨ h - k , f ⟩) ≤ c*∥ f ∥^2)›
by simp
have ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ 2 * Re (⟨ h - k , f ⟩) ≤ 0)›
using q3
by (simp add: q4 that)
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ (2 * Re (⟨ h - k , (-1) *⇩R f ⟩)) ≤ 0)›
using assms scaleR_scaleC complex_vector.subspace_def
by (metis ‹csubspace M›)
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ -(2 * Re (⟨ h - k , f ⟩)) ≤ 0)›
by simp
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ 2 * Re (⟨ h - k , f ⟩) ≥ 0)›
by simp
hence ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ 2 * Re (⟨ h - k , f ⟩) = 0)›
using ‹∀ f. f ∈ M ⟶
(∀ c::real. c > 0 ⟶ (2 * Re (⟨ h - k , f ⟩)) ≤ 0)›
by fastforce
have ‹∀ f. f ∈ M ⟶
((1::real) > 0 ⟶ 2 * Re (⟨ h - k , f ⟩) = 0)›
using ‹∀f. f ∈ M ⟶ (∀c>0. 2 * Re (⟨h - k , f⟩ ) = 0)› by blast
hence ‹∀ f. f ∈ M ⟶ 2 * Re (⟨ h - k , f ⟩) = 0›
by simp
hence ‹∀ f. f ∈ M ⟶ Re (⟨ h - k , f ⟩) = 0›
by simp
have ‹∀ f. f ∈ M ⟶ Re (⟨ h - k , (Complex 0 (-1)) *⇩C f ⟩) = 0›
using assms complex_vector.subspace_def ‹csubspace M›
by (metis ‹∀f. f ∈ M ⟶ Re ⟨h - k, f⟩ = 0›)
hence ‹∀ f. f ∈ M ⟶ Re ( (Complex 0 (-1))*(⟨ h - k , f ⟩) ) = 0›
by simp
hence ‹∀ f. f ∈ M ⟶ Im (⟨ h - k , f ⟩) = 0›
using Complex_eq_neg_1 Re_i_times cinner_scaleC_right complex_of_real_def by auto
have ‹∀ f. f ∈ M ⟶ (⟨ h - k , f ⟩) = 0›
using complex_eq_iff
by (simp add: ‹∀f. f ∈ M ⟶ Im ⟨h - k, f⟩ = 0› ‹∀f. f ∈ M ⟶ Re ⟨h - k, f⟩ = 0›)
hence ‹h - k ∈ orthogonal_complement M ∧ k ∈ M›
by (simp add: ‹k ∈ M› orthogonal_complementI)
have ‹∀ c. c *⇩R f ∈ M›
if "f ∈ M"
for f
using that scaleR_scaleC ‹csubspace M› complex_vector.subspace_def
by (simp add: complex_vector.subspace_def scaleR_scaleC)
have ‹⟨ h - k , f ⟩ = 0›
if "f ∈ M"
for f
using ‹h - k ∈ orthogonal_complement M ∧ k ∈ M› orthogonal_complement_orthoI that by auto
hence ‹h - k ∈ orthogonal_complement M›
by (simp add: orthogonal_complement_def)
thus ?thesis
using ‹k ∈ M› by auto
qed
have q1: ‹dist h k ≤ dist h f ›
if "f ∈ M" and ‹h - k ∈ orthogonal_complement M ∧ k ∈ M›
for f
proof-
have ‹⟨ h - k, k - f ⟩ = 0›
by (metis (no_types, lifting) that
cinner_diff_right diff_0_right orthogonal_complement_orthoI that)
have ‹∥ h - f ∥^2 = ∥ (h - k) + (k - f) ∥^2›
by simp
also have ‹... = ∥ h - k ∥^2 + ∥ k - f ∥^2›
using ‹⟨ h - k, k - f ⟩ = 0› pythagorean_theorem by blast
also have ‹... ≥ ∥ h - k ∥^2›
by simp
finally have ‹∥h - k∥⇧2 ≤ ∥h - f∥⇧2 ›
by blast
hence ‹∥h - k∥ ≤ ∥h - f∥›
using norm_ge_zero power2_le_imp_le by blast
thus ?thesis
by (simp add: dist_norm)
qed
have w1: "is_arg_min (λ x. dist x h) (λ x. x ∈ M) k"
if "h - k ∈ orthogonal_complement M ∧ k ∈ M"
proof-
have ‹h - k ∈ orthogonal_complement M›
using that by blast
have ‹k ∈ M› using ‹h - k ∈ orthogonal_complement M ∧ k ∈ M›
by blast
thus ?thesis
by (metis (no_types, lifting) dist_commute is_arg_min_linorder q1 that)
qed
show ?thesis
using w1 w2 by blast
qed
corollary orthog_proj_exists:
fixes M :: ‹'a::chilbert_space set›
assumes ‹closed_csubspace M›
shows ‹∃k. h - k ∈ orthogonal_complement M ∧ k ∈ M›
proof-
from ‹closed_csubspace M›
have ‹M ≠ {}›
using closed_csubspace.subspace complex_vector.subspace_0 by blast
have ‹closed M›
using ‹closed_csubspace M›
by (simp add: closed_csubspace.closed)
have ‹convex M›
using ‹closed_csubspace M›
by (simp)
have ‹∃k. is_arg_min (λ x. dist x h) (λ x. x ∈ M) k›
by (simp add: smallest_dist_exists ‹closed M› ‹convex M› ‹M ≠ {}›)
thus ?thesis
by (simp add: assms smallest_dist_is_ortho)
qed
corollary orthog_proj_unique:
fixes M :: ‹'a::complex_inner set›
assumes ‹closed_csubspace M›
assumes ‹h - r ∈ orthogonal_complement M ∧ r ∈ M›
assumes ‹h - s ∈ orthogonal_complement M ∧ s ∈ M›
shows ‹r = s›
using _ assms(2,3) unfolding smallest_dist_is_ortho[OF assms(1), symmetric]
apply (rule smallest_dist_unique)
using assms(1) by (simp)
definition is_projection_on::‹('a ⇒ 'a) ⇒ ('a::metric_space) set ⇒ bool› where
‹is_projection_on π M ⟷ (∀h. is_arg_min (λ x. dist x h) (λ x. x ∈ M) (π h))›
lemma is_projection_on_iff_orthog:
‹closed_csubspace M ⟹ is_projection_on π M ⟷ (∀h. h - π h ∈ orthogonal_complement M ∧ π h ∈ M)›
by (simp add: is_projection_on_def smallest_dist_is_ortho)
lemma is_projection_on_exists:
fixes M :: ‹'a::chilbert_space set›
assumes ‹convex M› and ‹closed M› and ‹M ≠ {}›
shows "∃π. is_projection_on π M"
unfolding is_projection_on_def apply (rule choice)
using smallest_dist_exists[OF assms] by auto
lemma is_projection_on_unique:
fixes M :: ‹'a::complex_inner set›
assumes ‹convex M›
assumes "is_projection_on π⇩1 M"
assumes "is_projection_on π⇩2 M"
shows "π⇩1 = π⇩2"
using smallest_dist_unique[OF assms(1)] using assms(2,3)
unfolding is_projection_on_def by blast
definition projection :: ‹'a::metric_space set ⇒ ('a ⇒ 'a)› where
‹projection M ≡ SOME π. is_projection_on π M›
lemma projection_is_projection_on:
fixes M :: ‹'a::chilbert_space set›
assumes ‹convex M› and ‹closed M› and ‹M ≠ {}›
shows "is_projection_on (projection M) M"
by (metis assms(1) assms(2) assms(3) is_projection_on_exists projection_def someI)
lemma projection_is_projection_on'[simp]:
fixes M :: ‹'a::chilbert_space set›
assumes ‹closed_csubspace M›
shows "is_projection_on (projection M) M"
apply (rule projection_is_projection_on)
apply (auto simp add: assms closed_csubspace.closed)
using assms closed_csubspace.subspace complex_vector.subspace_0 by blast
lemma projection_orthogonal:
fixes M :: ‹'a::chilbert_space set›
assumes "closed_csubspace M" and ‹m ∈ M›
shows ‹is_orthogonal (h - projection M h) m›
by (metis assms(1) assms(2) closed_csubspace.closed closed_csubspace.subspace csubspace_is_convex empty_iff is_projection_on_iff_orthog orthogonal_complement_orthoI projection_is_projection_on)
lemma is_projection_on_in_image:
assumes "is_projection_on π M"
shows "π h ∈ M"
using assms
by (simp add: is_arg_min_def is_projection_on_def)
lemma is_projection_on_image:
assumes "is_projection_on π M"
shows "range π = M"
using assms
apply (auto simp: is_projection_on_in_image)
by (smt (verit, ccfv_threshold) dist_pos_lt dist_self is_arg_min_def is_projection_on_def rangeI)
lemma projection_in_image[simp]:
fixes M :: ‹'a::chilbert_space set›
assumes ‹convex M› and ‹closed M› and ‹M ≠ {}›
shows ‹projection M h ∈ M›
by (simp add: assms(1) assms(2) assms(3) is_projection_on_in_image projection_is_projection_on)
lemma projection_image[simp]:
fixes M :: ‹'a::chilbert_space set›
assumes ‹convex M› and ‹closed M› and ‹M ≠ {}›
shows ‹range (projection M) = M›
by (simp add: assms(1) assms(2) assms(3) is_projection_on_image projection_is_projection_on)
lemma projection_eqI':
fixes M :: ‹'a::complex_inner set›
assumes ‹convex M›
assumes ‹is_projection_on f M›
shows ‹projection M = f›
by (metis assms(1) assms(2) is_projection_on_unique projection_def someI_ex)
lemma is_projection_on_eqI:
fixes M :: ‹'a::complex_inner set›
assumes a1: ‹closed_csubspace M› and a2: ‹h - x ∈ orthogonal_complement M› and a3: ‹x ∈ M›
and a4: ‹is_projection_on π M›
shows ‹π h = x›
by (meson a1 a2 a3 a4 closed_csubspace.subspace csubspace_is_convex is_projection_on_def smallest_dist_is_ortho smallest_dist_unique)
lemma projection_eqI:
fixes M :: ‹('a::chilbert_space) set›
assumes ‹closed_csubspace M› and ‹h - x ∈ orthogonal_complement M› and ‹x ∈ M›
shows ‹projection M h = x›
by (metis assms(1) assms(2) assms(3) is_projection_on_iff_orthog orthog_proj_exists projection_def is_projection_on_eqI tfl_some)
lemma is_projection_on_fixes_image:
fixes M :: ‹'a::metric_space set›
assumes a1: "is_projection_on π M" and a3: "x ∈ M"
shows "π x = x"
by (metis a1 a3 dist_pos_lt dist_self is_arg_min_def is_projection_on_def)
lemma projection_fixes_image:
fixes M :: ‹('a::chilbert_space) set›
assumes a1: "closed_csubspace M" and a2: "x ∈ M"
shows "(projection M) x = x"
using is_projection_on_fixes_image
by (simp add: a1 a2 complex_vector.subspace_0 projection_eqI)
proposition is_projection_on_reduces_norm:
includes notation_norm
fixes M :: ‹('a::complex_inner) set›
assumes ‹is_projection_on π M› and ‹closed_csubspace M›
shows ‹∥ π h ∥ ≤ ∥ h ∥›
proof-
have ‹h - π h ∈ orthogonal_complement M›
using assms is_projection_on_iff_orthog by blast
hence ‹∀ k ∈ M. ⟨ h - π h , k ⟩ = 0›
using orthogonal_complement_orthoI by blast
also have ‹π h ∈ M›
using ‹is_projection_on π M›
by (simp add: is_projection_on_in_image)
ultimately have ‹⟨ h - π h , π h ⟩ = 0›
by auto
hence ‹∥ π h ∥^2 + ∥ h - π h ∥^2 = ∥ h ∥^2›
using pythagorean_theorem by fastforce
hence ‹∥π h ∥^2 ≤ ∥ h ∥^2›
by (smt zero_le_power2)
thus ?thesis
using norm_ge_zero power2_le_imp_le by blast
qed
proposition projection_reduces_norm:
includes notation_norm
fixes M :: ‹'a::chilbert_space set›
assumes a1: "closed_csubspace M"
shows ‹∥ projection M h ∥ ≤ ∥ h ∥›
using assms is_projection_on_iff_orthog orthog_proj_exists is_projection_on_reduces_norm projection_eqI by blast
theorem is_projection_on_bounded_clinear:
fixes M :: ‹'a::complex_inner set›
assumes a1: "is_projection_on π M" and a2: "closed_csubspace M"
shows "bounded_clinear π"
proof
have b1: ‹csubspace (orthogonal_complement M)›
by (simp add: a2)
have f1: "∀a. a - π a ∈ orthogonal_complement M ∧ π a ∈ M"
using a1 a2 is_projection_on_iff_orthog by blast
hence "c *⇩C x - c *⇩C π x ∈ orthogonal_complement M"
for c x
by (metis (no_types) b1
add_diff_cancel_right' complex_vector.subspace_def diff_add_cancel scaleC_add_right)
thus r1: ‹π (c *⇩C x) = c *⇩C (π x)› for x c
using f1 by (meson a2 a1 closed_csubspace.subspace
complex_vector.subspace_def is_projection_on_eqI)
show r2: ‹π (x + y) = (π x) + (π y)›
for x y
proof-
have "∀A. ¬ closed_csubspace (A::'a set) ∨ csubspace A"
by (metis closed_csubspace.subspace)
hence "csubspace M"
using a2 by auto
hence ‹π (x + y) - ( (π x) + (π y) ) ∈ M›
by (simp add: complex_vector.subspace_add complex_vector.subspace_diff f1)
have ‹closed_csubspace (orthogonal_complement M)›
using a2
by simp
have f1: "∀a b. (b::'a) + (a - b) = a"
by (metis add.commute diff_add_cancel)
have f2: "∀a b. (b::'a) - b = a - a"
by auto
hence f3: "∀a. a - a ∈ orthogonal_complement M"
by (simp add: complex_vector.subspace_0)
have "∀a b. (a ∈ orthogonal_complement M ∨ a + b ∉ orthogonal_complement M)
∨ b ∉ orthogonal_complement M"
using add_diff_cancel_right' b1 complex_vector.subspace_diff
by metis
hence "∀a b c. (a ∈ orthogonal_complement M ∨ c - (b + a) ∉ orthogonal_complement M)
∨ c - b ∉ orthogonal_complement M"
using f1 by (metis diff_diff_add)
hence f4: "∀a b f. (f a - b ∈ orthogonal_complement M ∨ a - b ∉ orthogonal_complement M)
∨ ¬ is_projection_on f M"
using f1
by (metis a2 is_projection_on_iff_orthog)
have f5: "∀a b c d. (d::'a) - (c + (b - a)) = d + (a - (b + c))"
by auto
have "x - π x ∈ orthogonal_complement M"
using a1 a2 is_projection_on_iff_orthog by blast
hence q1: ‹π (x + y) - ( (π x) + (π y) ) ∈ orthogonal_complement M›
using f5 f4 f3 by (metis ‹csubspace (orthogonal_complement M)›
‹is_projection_on π M› add_diff_eq complex_vector.subspace_diff diff_diff_add
diff_diff_eq2)
hence ‹π (x + y) - ( (π x) + (π y) ) ∈ M ∩ (orthogonal_complement M)›
by (simp add: ‹π (x + y) - (π x + π y) ∈ M›)
moreover have ‹M ∩ (orthogonal_complement M) = {0}›
by (simp add: ‹closed_csubspace M› complex_vector.subspace_0 orthogonal_complement_zero_intersection)
ultimately have ‹π (x + y) - ( (π x) + (π y) ) = 0›
by auto
thus ?thesis by simp
qed
from is_projection_on_reduces_norm
show t1: ‹∃ K. ∀ x. norm (π x) ≤ norm x * K›
by (metis a1 a2 mult.left_neutral ordered_field_class.sign_simps(5))
qed
theorem projection_bounded_clinear:
fixes M :: ‹('a::chilbert_space) set›
assumes a1: "closed_csubspace M"
shows ‹bounded_clinear (projection M)›
using assms is_projection_on_iff_orthog orthog_proj_exists is_projection_on_bounded_clinear projection_eqI by blast
proposition is_projection_on_idem:
fixes M :: ‹('a::complex_inner) set›
assumes "is_projection_on π M"
shows "π (π x) = π x"
using is_projection_on_fixes_image is_projection_on_in_image assms by blast
proposition projection_idem:
fixes M :: "'a::chilbert_space set"
assumes a1: "closed_csubspace M"
shows "projection M (projection M x) = projection M x"
by (metis assms closed_csubspace.closed closed_csubspace.subspace complex_vector.subspace_0 csubspace_is_convex equals0D projection_fixes_image projection_in_image)
proposition is_projection_on_kernel_is_orthogonal_complement:
fixes M :: ‹'a::complex_inner set›
assumes a1: "is_projection_on π M" and a2: "closed_csubspace M"
shows "π -` {0} = orthogonal_complement M"
proof-
have "x ∈ (π -` {0})"
if "x ∈ orthogonal_complement M"
for x
by (smt (verit, ccfv_SIG) a1 a2 closed_csubspace_def complex_vector.subspace_def complex_vector.subspace_diff is_projection_on_eqI orthogonal_complement_closed_subspace that vimage_singleton_eq)
moreover have "x ∈ orthogonal_complement M"
if s1: "x ∈ π -` {0}" for x
by (metis a1 a2 diff_zero is_projection_on_iff_orthog that vimage_singleton_eq)
ultimately show ?thesis
by blast
qed
proposition projection_kernel_is_orthogonal_complement:
fixes M :: ‹'a::chilbert_space set›
assumes "closed_csubspace M"
shows "(projection M) -` {0} = (orthogonal_complement M)"
by (metis assms closed_csubspace_def complex_vector.subspace_def csubspace_is_convex insert_absorb insert_not_empty is_projection_on_kernel_is_orthogonal_complement projection_is_projection_on)
lemma is_projection_on_id_minus:
fixes M :: ‹'a::complex_inner set›
assumes is_proj: "is_projection_on π M"
and cc: "closed_csubspace M"
shows "is_projection_on (id - π) (orthogonal_complement M)"
using is_proj apply (simp add: cc is_projection_on_iff_orthog)
using double_orthogonal_complement_increasing by blast
text ‹Exercise 2 (section 2, chapter I) in @{cite conway2013course}›
lemma projection_on_orthogonal_complement[simp]:
fixes M :: "'a::chilbert_space set"
assumes a1: "closed_csubspace M"
shows "projection (orthogonal_complement M) = id - projection M"
apply (auto intro!: ext)
by (smt (verit, ccfv_SIG) add_diff_cancel_left' assms closed_csubspace.closed closed_csubspace.subspace complex_vector.subspace_0 csubspace_is_convex diff_add_cancel double_orthogonal_complement_increasing insert_absorb insert_not_empty is_projection_on_iff_orthog orthogonal_complement_closed_subspace projection_eqI projection_is_projection_on subset_eq)
lemma is_projection_on_zero:
"is_projection_on (λ_. 0) {0}"
by (simp add: is_projection_on_def is_arg_min_def)
lemma projection_zero[simp]:
"projection {0} = (λ_. 0)"
using is_projection_on_zero
by (metis (full_types) is_projection_on_in_image projection_def singletonD someI_ex)
lemma is_projection_on_rank1:
fixes t :: ‹'a::complex_inner›
shows ‹is_projection_on (λx. (⟨t , x⟩ / ⟨t , t⟩) *⇩C t) (cspan {t})›
proof (cases ‹t = 0›)
case True
then show ?thesis
by (simp add: is_projection_on_zero)
next
case False
define P where ‹P x = (⟨t , x⟩ / ⟨t , t⟩) *⇩C t› for x
define t' where ‹t' = t /⇩C norm t›
with False have ‹norm t' = 1›
by (simp add: norm_inverse)
have P_def': ‹P x = cinner t' x *⇩C t'› for x
unfolding P_def t'_def apply auto
by (metis divide_divide_eq_left divide_inverse mult.commute power2_eq_square power2_norm_eq_cinner)
have spant': ‹cspan {t} = cspan {t'}›
by (simp add: False t'_def)
have cc: ‹closed_csubspace (cspan {t})›
by (auto intro!: finite_cspan_closed closed_csubspace.intro)
have ortho: ‹h - P h ∈ orthogonal_complement (cspan {t})› for h
unfolding orthogonal_complement_def P_def' spant' apply auto
by (smt (verit, ccfv_threshold) ‹norm t' = 1› add_cancel_right_left cinner_add_right cinner_commute' cinner_scaleC_right cnorm_eq_1 complex_vector.span_breakdown_eq complex_vector.span_empty diff_add_cancel mult_cancel_left1 singletonD)
have inspan: ‹P h ∈ cspan {t}› for h
unfolding P_def' spant'
by (simp add: complex_vector.span_base complex_vector.span_scale)
show ‹is_projection_on P (cspan {t})›
apply (subst is_projection_on_iff_orthog)
using cc ortho inspan by auto
qed
lemma projection_rank1:
fixes t x :: ‹'a::complex_inner›
shows ‹projection (cspan {t}) x = (⟨t , x⟩ / ⟨t , t⟩) *⇩C t›
apply (rule fun_cong, rule projection_eqI', simp)
by (rule is_projection_on_rank1)
subsection ‹More orthogonal complement›
text ‹The following lemmas logically fit into the "orthogonality" section but depend on projections for their proofs.›
text ‹Corollary 2.8 in @{cite conway2013course}›
theorem double_orthogonal_complement_id[simp]:
fixes M :: ‹'a::chilbert_space set›
assumes a1: "closed_csubspace M"
shows "orthogonal_complement (orthogonal_complement M) = M"
proof-
have b2: "x ∈ (id - projection M) -` {0}"
if c1: "x ∈ M" for x
by (simp add: assms projection_fixes_image that)
have b3: ‹x ∈ M›
if c1: ‹x ∈ (id - projection M) -` {0}› for x
by (metis assms closed_csubspace.closed closed_csubspace.subspace complex_vector.subspace_0 csubspace_is_convex eq_id_iff equals0D fun_diff_def projection_in_image right_minus_eq that vimage_singleton_eq)
have ‹x ∈ M ⟷ x ∈ (id - projection M) -` {0}› for x
using b2 b3 by blast
hence b4: ‹( id - (projection M) ) -` {0} = M›
by blast
have b1: "orthogonal_complement (orthogonal_complement M)
= (projection (orthogonal_complement M)) -` {0}"
by (simp add: a1 projection_kernel_is_orthogonal_complement del: projection_on_orthogonal_complement)
also have ‹... = ( id - (projection M) ) -` {0}›
by (simp add: a1)
also have ‹... = M›
by (simp add: b4)
finally show ?thesis by blast
qed
lemma orthogonal_complement_antimono[simp]:
fixes A B :: ‹('a::complex_inner) set›
assumes "A ⊇ B"
shows ‹orthogonal_complement A ⊆ orthogonal_complement B›
by (meson assms orthogonal_complementI orthogonal_complement_orthoI' subsetD subsetI)
lemma orthogonal_complement_antimono_iff[simp]:
fixes A B :: ‹('a::chilbert_space) set›
assumes ‹closed_csubspace A› and ‹closed_csubspace B›
shows ‹orthogonal_complement A ⊆ orthogonal_complement B ⟷ A ⊇ B›
proof
show ‹orthogonal_complement A ⊆ orthogonal_complement B› if ‹A ⊇ B›
using that by auto
assume ‹orthogonal_complement A ⊆ orthogonal_complement B›
then have ‹orthogonal_complement (orthogonal_complement A) ⊇ orthogonal_complement (orthogonal_complement B)›
by simp
then show ‹A ⊇ B›
using assms by auto
qed
lemma orthogonal_complement_UNIV[simp]:
"orthogonal_complement UNIV = {0}"
by (metis Int_UNIV_left complex_vector.subspace_UNIV complex_vector.subspace_def orthogonal_complement_zero_intersection)
lemma orthogonal_complement_zero[simp]:
"orthogonal_complement {0} = UNIV"
unfolding orthogonal_complement_def by auto
lemma de_morgan_orthogonal_complement_plus:
fixes A B::"('a::complex_inner) set"
assumes ‹0 ∈ A› and ‹0 ∈ B›
shows ‹orthogonal_complement (A +⇩M B) = (orthogonal_complement A) ∩ (orthogonal_complement B)›
proof-
have "x ∈ (orthogonal_complement A) ∩ (orthogonal_complement B)"
if "x ∈ orthogonal_complement (A +⇩M B)"
for x
proof-
have ‹orthogonal_complement (A +⇩M B) = orthogonal_complement (A + B)›
unfolding closed_sum_def by (subst orthogonal_complement_of_closure[symmetric], simp)
hence ‹x ∈ orthogonal_complement (A + B)›
using that by blast
hence t1: ‹∀z ∈ (A + B). ⟨ z , x ⟩ = 0›
by (simp add: orthogonal_complement_orthoI')
have ‹A ⊆ A + B›
using subset_iff add.commute set_zero_plus2 ‹0 ∈ B›
by fastforce
hence ‹∀z ∈ A. ⟨ z , x ⟩ = 0›
using t1 by auto
hence w1: ‹x ∈ (orthogonal_complement A)›
by (smt mem_Collect_eq is_orthogonal_sym orthogonal_complement_def)
have ‹B ⊆ A + B›
using ‹0 ∈ A› subset_iff set_zero_plus2 by blast
hence ‹∀ z ∈ B. ⟨ z , x ⟩ = 0›
using t1 by auto
hence ‹x ∈ (orthogonal_complement B)›
by (smt mem_Collect_eq is_orthogonal_sym orthogonal_complement_def)
thus ?thesis
using w1 by auto
qed
moreover have "x ∈ (orthogonal_complement (A +⇩M B))"
if v1: "x ∈ (orthogonal_complement A) ∩ (orthogonal_complement B)"
for x
proof-
have ‹x ∈ (orthogonal_complement A)›
using v1
by blast
hence ‹∀y∈ A. ⟨ y , x ⟩ = 0›
by (simp add: orthogonal_complement_orthoI')
have ‹x ∈ (orthogonal_complement B)›
using v1
by blast
hence ‹∀ y∈ B. ⟨ y , x ⟩ = 0›
by (simp add: orthogonal_complement_orthoI')
have ‹∀ a∈A. ∀ b∈B. ⟨ a+b , x ⟩ = 0›
by (simp add: ‹∀y∈A. ⟨y , x⟩ = 0› ‹∀y∈B. ⟨y , x⟩ = 0› cinner_add_left)
hence ‹∀ y ∈ (A + B). ⟨ y , x ⟩ = 0›
using set_plus_elim by force
hence ‹x ∈ (orthogonal_complement (A + B))›
by (smt mem_Collect_eq is_orthogonal_sym orthogonal_complement_def)
moreover have ‹(orthogonal_complement (A + B)) = (orthogonal_complement (A +⇩M B))›
unfolding closed_sum_def by (subst orthogonal_complement_of_closure[symmetric], simp)
ultimately have ‹x ∈ (orthogonal_complement (A +⇩M B))›
by blast
thus ?thesis
by blast
qed
ultimately show ?thesis by blast
qed
lemma de_morgan_orthogonal_complement_inter:
fixes A B::"'a::chilbert_space set"
assumes a1: ‹closed_csubspace A› and a2: ‹closed_csubspace B›
shows ‹orthogonal_complement (A ∩ B) = orthogonal_complement A +⇩M orthogonal_complement B›
proof-
have ‹orthogonal_complement A +⇩M orthogonal_complement B
= orthogonal_complement (orthogonal_complement (orthogonal_complement A +⇩M orthogonal_complement B))›
by (simp add: closed_subspace_closed_sum)
also have ‹… = orthogonal_complement (orthogonal_complement (orthogonal_complement A) ∩ orthogonal_complement (orthogonal_complement B))›
by (simp add: de_morgan_orthogonal_complement_plus orthogonal_complementI)
also have ‹… = orthogonal_complement (A ∩ B)›
by (simp add: a1 a2)
finally show ?thesis
by simp
qed
subsection ‹Riesz-representation theorem›
lemma orthogonal_complement_kernel_functional:
fixes f :: ‹'a::complex_inner ⇒ complex›
assumes ‹bounded_clinear f›
shows ‹∃x. orthogonal_complement (f -` {0}) = cspan {x}›
proof (cases ‹orthogonal_complement (f -` {0}) = {0}›)
case True
then show ?thesis
apply (rule_tac x=0 in exI) by auto
next
case False
then obtain x where xortho: ‹x ∈ orthogonal_complement (f -` {0})› and xnon0: ‹x ≠ 0›
using complex_vector.subspace_def by fastforce
from xnon0 xortho
have r1: ‹f x ≠ 0›
by (metis cinner_eq_zero_iff orthogonal_complement_orthoI vimage_singleton_eq)
have ‹∃ k. y = k *⇩C x› if ‹y ∈ orthogonal_complement (f -` {0})› for y
proof (cases ‹y = 0›)
case True
then show ?thesis by auto
next
case False
with that
have ‹f y ≠ 0›
by (metis cinner_eq_zero_iff orthogonal_complement_orthoI vimage_singleton_eq)
then obtain k where k_def: ‹f x = k * f y›
by (metis add.inverse_inverse minus_divide_eq_eq)
with assms have ‹f x = f (k *⇩C y)›
by (simp add: bounded_clinear.axioms(1) clinear.scaleC)
hence ‹f x - f (k *⇩C y) = 0›
by simp
with assms have s1: ‹f (x - k *⇩C y) = 0›
by (simp add: bounded_clinear.axioms(1) complex_vector.linear_diff)
from that have ‹k *⇩C y ∈ orthogonal_complement (f -` {0})›
by (simp add: complex_vector.subspace_scale)
with xortho have s2: ‹x - (k *⇩C y) ∈ orthogonal_complement (f -` {0})›
by (simp add: complex_vector.subspace_diff)
have s3: ‹(x - (k *⇩C y)) ∈ f -` {0}›
using s1 by simp
moreover have ‹(f -` {0}) ∩ (orthogonal_complement (f -` {0})) = {0}›
by (meson assms closed_csubspace_def complex_vector.subspace_def kernel_is_closed_csubspace
orthogonal_complement_zero_intersection)
ultimately have ‹x - (k *⇩C y) = 0›
using s2 by blast
thus ?thesis
by (metis ceq_vector_fraction_iff eq_iff_diff_eq_0 k_def r1 scaleC_scaleC)
qed
then have ‹orthogonal_complement (f -` {0}) ⊆ cspan {x}›
using complex_vector.span_superset complex_vector.subspace_scale by blast
moreover from xortho have ‹orthogonal_complement (f -` {0}) ⊇ cspan {x}›
by (simp add: complex_vector.span_minimal)
ultimately show ?thesis
by auto
qed
lemma riesz_frechet_representation_existence:
fixes f::‹'a::chilbert_space ⇒ complex›
assumes a1: ‹bounded_clinear f›
shows ‹∃t. ∀x. f x = ⟨t, x⟩›
proof(cases ‹∀ x. f x = 0›)
case True
thus ?thesis
by (metis cinner_zero_left)
next
case False
obtain t where spant: ‹orthogonal_complement (f -` {0}) = cspan {t}›
using orthogonal_complement_kernel_functional
using assms by blast
have ‹projection (orthogonal_complement (f -` {0})) x = (⟨t , x⟩/⟨t , t⟩) *⇩C t› for x
apply (subst spant) by (rule projection_rank1)
hence ‹f (projection (orthogonal_complement (f -` {0})) x) = ((⟨t , x⟩)/(⟨t , t⟩)) * (f t)› for x
using a1 unfolding bounded_clinear_def
by (simp add: complex_vector.linear_scale)
hence l2: ‹f (projection (orthogonal_complement (f -` {0})) x) = ⟨((cnj (f t)/⟨t , t⟩) *⇩C t) , x⟩› for x
using complex_cnj_divide by force
have ‹f (projection (f -` {0}) x) = 0› for x
by (metis (no_types, lifting) assms bounded_clinear_def closed_csubspace.closed
complex_vector.linear_subspace_vimage complex_vector.subspace_0 complex_vector.subspace_single_0
csubspace_is_convex insert_absorb insert_not_empty kernel_is_closed_csubspace projection_in_image vimage_singleton_eq)
hence "⋀a b. f (projection (f -` {0}) a + b) = 0 + f b"
using additive.add assms
by (simp add: bounded_clinear_def complex_vector.linear_add)
hence "⋀a. 0 + f (projection (orthogonal_complement (f -` {0})) a) = f a"
apply (simp add: assms)
by (metis add.commute diff_add_cancel)
hence ‹f x = ⟨(cnj (f t)/⟨t , t⟩) *⇩C t, x⟩› for x
by (simp add: l2)
thus ?thesis
by blast
qed
lemma riesz_frechet_representation_unique:
fixes f::‹'a::complex_inner ⇒ complex›
assumes ‹⋀x. f x = ⟨t, x⟩›
assumes ‹⋀x. f x = ⟨u, x⟩›
shows ‹t = u›
by (metis add_diff_cancel_left' assms(1) assms(2) cinner_diff_left cinner_gt_zero_iff diff_add_cancel diff_zero)
subsection ‹Adjoints›
definition "is_cadjoint F G ⟷ (∀x. ∀y. ⟨F x, y⟩ = ⟨x, G y⟩)"
lemma is_adjoint_sym:
‹is_cadjoint F G ⟹ is_cadjoint G F›
unfolding is_cadjoint_def apply auto
by (metis cinner_commute')
definition ‹cadjoint G = (SOME F. is_cadjoint F G)›
for G :: "'b::complex_inner ⇒ 'a::complex_inner"
lemma cadjoint_exists:
fixes G :: "'b::chilbert_space ⇒ 'a::complex_inner"
assumes [simp]: ‹bounded_clinear G›
shows ‹∃F. is_cadjoint F G›
proof -
include notation_norm
have [simp]: ‹clinear G›
using assms unfolding bounded_clinear_def by blast
define g :: ‹'a ⇒ 'b ⇒ complex›
where ‹g x y = ⟨x , G y⟩› for x y
have ‹bounded_clinear (g x)› for x
proof -
have ‹g x (a + b) = g x a + g x b› for a b
unfolding g_def
using additive.add cinner_add_right clinear_def
by (simp add: cinner_add_right complex_vector.linear_add)
moreover have ‹g x (k *⇩C a) = k *⇩C (g x a)›
for a k
unfolding g_def
by (simp add: complex_vector.linear_scale)
ultimately have ‹clinear (g x)›
by (simp add: clinearI)
moreover
have ‹∃ M. ∀ y. ∥ G y ∥ ≤ ∥ y ∥ * M›
using ‹bounded_clinear G›
unfolding bounded_clinear_def bounded_clinear_axioms_def by blast
then have ‹∃M. ∀y. ∥ g x y ∥ ≤ ∥ y ∥ * M›
using g_def
by (simp add: bounded_clinear.bounded bounded_clinear_cinner_right_comp)
ultimately show ?thesis unfolding bounded_linear_def
using bounded_clinear.intro
using bounded_clinear_axioms_def by blast
qed
hence ‹∀x. ∃t. ∀y. g x y = ⟨t, y⟩›
using riesz_frechet_representation_existence by blast
then obtain F where ‹∀x. ∀y. g x y = ⟨F x, y⟩›
by metis
then have ‹is_cadjoint F G›
unfolding is_cadjoint_def g_def by simp
thus ?thesis
by auto
qed
lemma cadjoint_is_cadjoint[simp]:
fixes G :: "'b::chilbert_space ⇒ 'a::complex_inner"
assumes [simp]: ‹bounded_clinear G›
shows ‹is_cadjoint (cadjoint G) G›
by (metis assms cadjoint_def cadjoint_exists someI_ex)
lemma is_cadjoint_unique:
assumes ‹is_cadjoint F1 G›
assumes ‹is_cadjoint F2 G›
shows ‹F1 = F2›
proof (rule ext)
fix x
{
fix y
have ‹cinner (F1 x - F2 x) y = cinner (F1 x) y - cinner (F2 x) y›
by (simp add: cinner_diff_left)
also have ‹… = cinner x (G y) - cinner x (G y)›
by (metis assms(1) assms(2) is_cadjoint_def)
also have ‹… = 0›
by simp
finally have ‹cinner (F1 x - F2 x) y = 0›
by -
}
then show ‹F1 x = F2 x›
by fastforce
qed
lemma cadjoint_univ_prop:
fixes G :: "'b::chilbert_space ⇒ 'a::complex_inner"
assumes a1: ‹bounded_clinear G›
shows ‹∀x. ∀y. ⟨cadjoint G x, y⟩ = ⟨x, G y⟩›
using assms cadjoint_is_cadjoint is_cadjoint_def by blast
lemma cadjoint_univ_prop':
fixes G :: "'b::chilbert_space ⇒ 'a::complex_inner"
assumes a1: ‹bounded_clinear G›
shows ‹∀x. ∀y. ⟨x, cadjoint G y⟩ = ⟨G x, y⟩›
by (metis cadjoint_univ_prop assms cinner_commute')
notation cadjoint ("_⇧†" [99] 100)
lemma cadjoint_eqI:
fixes G:: ‹'b::complex_inner ⇒ 'a::complex_inner›
and F:: ‹'a ⇒ 'b›
assumes ‹⋀x y. ⟨F x, y⟩ = ⟨x, G y⟩›
shows ‹G⇧† = F›
by (metis assms cadjoint_def is_cadjoint_def is_cadjoint_unique someI_ex)
lemma cadjoint_bounded_clinear:
fixes A :: "'a::chilbert_space ⇒ 'b::complex_inner"
assumes a1: "bounded_clinear A"
shows ‹bounded_clinear (A⇧†)›
proof
include notation_norm
have b1: ‹⟨(A⇧†) x, y⟩ = ⟨x , A y⟩› for x y
using cadjoint_univ_prop a1 by auto
have ‹⟨(A⇧†) (x1 + x2) - ((A⇧†) x1 + (A⇧†) x2) , y⟩ = 0› for x1 x2 y
by (simp add: b1 cinner_diff_left cinner_add_left)
hence b2: ‹(A⇧†) (x1 + x2) - ((A⇧†) x1 + (A⇧†) x2) = 0› for x1 x2
using cinner_eq_zero_iff by blast
thus z1: ‹(A⇧†) (x1 + x2) = (A⇧†) x1 + (A⇧†) x2› for x1 x2
by (simp add: b2 eq_iff_diff_eq_0)
have f1: ‹⟨(A⇧†) (r *⇩C x) - (r *⇩C (A⇧†) x ), y⟩ = 0› for r x y
by (simp add: b1 cinner_diff_left)
thus z2: ‹(A⇧†) (r *⇩C x) = r *⇩C (A⇧†) x› for r x
using cinner_eq_zero_iff eq_iff_diff_eq_0 by blast
have ‹∥ (A⇧†) x ∥^2 = ⟨(A⇧†) x, (A⇧†) x⟩› for x
by (metis cnorm_eq_square)
moreover have ‹∥ (A⇧†) x ∥^2 ≥ 0› for x
by simp
ultimately have ‹∥ (A⇧†) x ∥^2 = ¦ ⟨(A⇧†) x, (A⇧†) x⟩ ¦› for x
by (metis abs_pos cinner_ge_zero)
hence ‹∥ (A⇧†) x ∥^2 = ¦ ⟨x, A ((A⇧†) x)⟩ ¦› for x
by (simp add: b1)
moreover have ‹¦⟨x , A ((A⇧†) x)⟩¦ ≤ ∥x∥ * ∥A ((A⇧†) x)∥› for x
by (simp add: abs_complex_def complex_inner_class.Cauchy_Schwarz_ineq2)
ultimately have b5: ‹∥ (A⇧†) x ∥^2 ≤ ∥x∥ * ∥A ((A⇧†) x)∥› for x
by (metis complex_of_real_mono_iff)
have ‹∃M. M ≥ 0 ∧ (∀ x. ∥A ((A⇧†) x)∥ ≤ M * ∥(A⇧†) x∥)›
using a1
by (metis (mono_tags, hide_lams) bounded_clinear.bounded linear mult_nonneg_nonpos
mult_zero_right norm_ge_zero order.trans semiring_normalization_rules(7))
then obtain M where q1: ‹M ≥ 0› and q2: ‹∀ x. ∥A ((A⇧†) x)∥ ≤ M * ∥(A⇧†) x∥›
by blast
have ‹∀ x::'b. ∥x∥ ≥ 0›
by simp
hence b6: ‹∥x∥ * ∥A ((A⇧†) x)∥ ≤ ∥x∥ * M * ∥(A⇧†) x∥› for x
using q2
by (smt ordered_comm_semiring_class.comm_mult_left_mono vector_space_over_itself.scale_scale)
have z3: ‹∥ (A⇧†) x ∥ ≤ ∥x∥ * M› for x
proof(cases ‹∥(A⇧†) x∥ = 0›)
case True
thus ?thesis
by (simp add: ‹0 ≤ M›)
next
case False
have ‹∥ (A⇧†) x ∥^2 ≤ ∥x∥ * M * ∥(A⇧†) x∥›
by (smt b5 b6)
thus ?thesis
by (smt False mult_right_cancel mult_right_mono norm_ge_zero semiring_normalization_rules(29))
qed
thus ‹∃K. ∀x. ∥(A⇧†) x∥ ≤ ∥x∥ * K›
by auto
qed
proposition double_cadjoint:
fixes U :: ‹'a::chilbert_space ⇒ 'b::complex_inner›
assumes a1: "bounded_clinear U"
shows "U⇧†⇧† = U"
by (metis assms cadjoint_def cadjoint_is_cadjoint is_adjoint_sym is_cadjoint_unique someI_ex)
lemma cadjoint_id: ‹(id::'a::complex_inner⇒'a)⇧† = id›
by (simp add: cadjoint_eqI id_def)
lemma scaleC_cadjoint:
fixes A::"'a::chilbert_space ⇒ 'b::complex_inner"
assumes "bounded_clinear A"
shows ‹(λt. a *⇩C (A t))⇧† = (λs. (cnj a) *⇩C ((A⇧†) s))›
proof-
have b3: ‹⟨(λ s. (cnj a) *⇩C ((A⇧†) s)) x, y ⟩ = ⟨x, (λ t. a *⇩C (A t)) y ⟩›
for x y
by (simp add: assms cadjoint_univ_prop)
have "((λt. a *⇩C A t)⇧†) b = cnj a *⇩C (A⇧†) b"
for b::'b
proof-
have "bounded_clinear (λt. a *⇩C A t)"
by (simp add: assms bounded_clinear_const_scaleC)
thus ?thesis
by (metis (no_types) cadjoint_eqI b3)
qed
thus ?thesis
by blast
qed
lemma is_projection_on_is_cadjoint:
fixes M :: ‹'a::complex_inner set›
assumes a1: ‹is_projection_on π M› and a2: ‹closed_csubspace M›
shows ‹is_cadjoint π π›
proof -
have ‹cinner (x - π x) y = 0› if ‹y∈M› for x y
using a1 a2 is_projection_on_iff_orthog orthogonal_complement_orthoI that by blast
then have ‹cinner x y = cinner (π x) y› if ‹y∈M› for x y
by (metis cinner_diff_left eq_iff_diff_eq_0 that)
moreover have ‹cinner x y = cinner x (π y)› if ‹y∈M› for x y
using a1 is_projection_on_fixes_image that by fastforce
ultimately have 1: ‹cinner (π x) y = cinner x (π y)› if ‹y∈M› for x y
using that by metis
have ‹cinner (π x) y = 0› if ‹y ∈ orthogonal_complement M› for x y
by (meson a1 is_projection_on_in_image orthogonal_complement_orthoI' that)
also have ‹0 = cinner x (π y)› if ‹y ∈ orthogonal_complement M› for x y
by (metis a1 a2 cinner_zero_right closed_csubspace.subspace complex_vector.subspace_0 diff_zero is_projection_on_eqI that)
finally have 2: ‹cinner (π x) y = cinner x (π y)› if ‹y ∈ orthogonal_complement M› for x y
using that by simp
from 1 2
have ‹cinner (π x) y = cinner x (π y)› for x y
by (smt (verit, ccfv_threshold) a1 a2 cinner_commute cinner_diff_left eq_iff_diff_eq_0 is_projection_on_iff_orthog orthogonal_complement_orthoI)
then show ?thesis
by (simp add: is_cadjoint_def)
qed
lemma is_projection_on_cadjoint:
fixes M :: ‹'a::complex_inner set›
assumes ‹is_projection_on π M› and ‹closed_csubspace M›
shows ‹π⇧† = π›
using assms is_projection_on_is_cadjoint cadjoint_eqI is_cadjoint_def by blast
lemma projection_cadjoint:
fixes M :: ‹'a::chilbert_space set›
assumes ‹closed_csubspace M›
shows ‹(projection M)⇧† = projection M›
using is_projection_on_cadjoint assms
by (metis closed_csubspace.closed closed_csubspace.subspace csubspace_is_convex empty_iff orthog_proj_exists projection_is_projection_on)
instance ccsubspace :: (chilbert_space) complete_orthomodular_lattice
proof
show "inf x (- x) = bot"
for x :: "'a ccsubspace"
apply transfer
by (simp add: closed_csubspace_def complex_vector.subspace_0 orthogonal_complement_zero_intersection)
have ‹t ∈ x +⇩M orthogonal_complement x›
if a1: ‹closed_csubspace x›
for t::'a and x
proof-
have e1: ‹t = (projection x) t + (projection (orthogonal_complement x)) t›
by (simp add: that)
have e2: ‹(projection x) t ∈ x›
by (metis closed_csubspace.closed closed_csubspace.subspace csubspace_is_convex empty_iff orthog_proj_exists projection_in_image that)
have e3: ‹(projection (orthogonal_complement x)) t ∈ orthogonal_complement x›
by (metis add_diff_cancel_left' e1 orthogonal_complementI projection_orthogonal that)
have "orthogonal_complement x ⊆ x +⇩M orthogonal_complement x"
by (simp add: closed_sum_right_subset complex_vector.subspace_0 that)
thus ?thesis
using ‹closed_csubspace x›
‹projection (orthogonal_complement x) t ∈ orthogonal_complement x› ‹projection x t ∈ x›
‹t = projection x t + projection (orthogonal_complement x) t› in_mono
closed_sum_left_subset complex_vector.subspace_def
by (metis closed_csubspace.subspace closed_subspace_closed_sum orthogonal_complement_closed_subspace)
qed
hence b1: ‹x +⇩M orthogonal_complement x = UNIV›
if a1: ‹closed_csubspace x›
for x::‹'a set›
using that by blast
show "sup x (- x) = top"
for x :: "'a ccsubspace"
apply transfer
using b1 by auto
show "- (- x) = x"
for x :: "'a ccsubspace"
apply transfer
by (simp)
show "- y ≤ - x"
if "x ≤ y"
for x :: "'a ccsubspace"
and y :: "'a ccsubspace"
using that apply transfer
by simp
have c1: "x +⇩M orthogonal_complement x ∩ y ⊆ y"
if "closed_csubspace x"
and "closed_csubspace y"
and "x ⊆ y"
for x :: "'a set"
and y :: "'a set"
using that
by (simp add: closed_sum_is_sup)
have c2: ‹u ∈ x +⇩M ((orthogonal_complement x) ∩ y)›
if a1: "closed_csubspace x" and a2: "closed_csubspace y" and a3: "x ⊆ y" and x1: ‹u ∈ y›
for x :: "'a set" and y :: "'a set" and u
proof-
have d4: ‹(projection x) u ∈ x›
by (metis a1 closed_csubspace_def csubspace_is_convex equals0D orthog_proj_exists projection_in_image)
hence d2: ‹(projection x) u ∈ y›
using a3 by auto
have d1: ‹csubspace y›
by (simp add: a2)
have ‹u - (projection x) u ∈ orthogonal_complement x›
by (simp add: a1 orthogonal_complementI projection_orthogonal)
moreover have ‹u - (projection x) u ∈ y›
by (simp add: d1 d2 complex_vector.subspace_diff x1)
ultimately have d3: ‹u - (projection x) u ∈ ((orthogonal_complement x) ∩ y)›
by simp
hence ‹∃ v ∈ ((orthogonal_complement x) ∩ y). u = (projection x) u + v›
by (metis d3 diff_add_cancel ordered_field_class.sign_simps(2))
then obtain v where ‹v ∈ ((orthogonal_complement x) ∩ y)› and ‹u = (projection x) u + v›
by blast
hence ‹u ∈ x + ((orthogonal_complement x) ∩ y)›
by (metis d4 set_plus_intro)
thus ?thesis
unfolding closed_sum_def
using closure_subset by blast
qed
have c3: "y ⊆ x +⇩M ((orthogonal_complement x) ∩ y)"
if a1: "closed_csubspace x" and a2: "closed_csubspace y" and a3: "x ⊆ y"
for x y :: "'a set"
using c2 a1 a2 a3 by auto
show "sup x (inf (- x) y) = y"
if "x ≤ y"
for x y :: "'a ccsubspace"
using that apply transfer
using c1 c3
by (simp add: subset_antisym)
show "x - y = inf x (- y)"
for x y :: "'a ccsubspace"
apply transfer
by simp
qed
subsection ‹More projections›
text ‹These lemmas logically belong in the "projections" section above but depend on lemmas developed later.›
lemma is_projection_on_plus:
assumes "⋀x y. x:A ⟹ y:B ⟹ is_orthogonal x y"
assumes ‹closed_csubspace A›
assumes ‹closed_csubspace B›
assumes ‹is_projection_on πA A›
assumes ‹is_projection_on πB B›
shows ‹is_projection_on (λx. πA x + πB x) (A +⇩M B)›
proof (rule is_projection_on_iff_orthog[THEN iffD2, rule_format])
show clAB: ‹closed_csubspace (A +⇩M B)›
by (simp add: assms(2) assms(3) closed_subspace_closed_sum)
fix h
have 1: ‹πA h + πB h ∈ A +⇩M B›
by (meson clAB assms(2) assms(3) assms(4) assms(5) closed_csubspace_def closed_sum_left_subset closed_sum_right_subset complex_vector.subspace_def in_mono is_projection_on_in_image)
have ‹πA (πB h) = 0›
by (smt (verit, del_insts) assms(1) assms(2) assms(4) assms(5) cinner_eq_zero_iff is_cadjoint_def is_projection_on_in_image is_projection_on_is_cadjoint)
then have ‹h - (πA h + πB h) = (h - πB h) - πA (h - πB h)›
by (smt (verit) add.right_neutral add_diff_cancel_left' assms(2) assms(4) closed_csubspace.subspace complex_vector.subspace_diff diff_add_eq_diff_diff_swap diff_diff_add is_projection_on_iff_orthog orthog_proj_unique orthogonal_complement_closed_subspace)
also have ‹… ∈ orthogonal_complement A›
using assms(2) assms(4) is_projection_on_iff_orthog by blast
finally have orthoA: ‹h - (πA h + πB h) ∈ orthogonal_complement A›
by -
have ‹πB (πA h) = 0›
by (smt (verit, del_insts) assms(1) assms(3) assms(4) assms(5) cinner_eq_zero_iff is_cadjoint_def is_projection_on_in_image is_projection_on_is_cadjoint)
then have ‹h - (πA h + πB h) = (h - πA h) - πB (h - πA h)›
by (smt (verit) add.right_neutral add_diff_cancel assms(3) assms(5) closed_csubspace.subspace complex_vector.subspace_diff diff_add_eq_diff_diff_swap diff_diff_add is_projection_on_iff_orthog orthog_proj_unique orthogonal_complement_closed_subspace)
also have ‹… ∈ orthogonal_complement B›
using assms(3) assms(5) is_projection_on_iff_orthog by blast
finally have orthoB: ‹h - (πA h + πB h) ∈ orthogonal_complement B›
by -
from orthoA orthoB
have 2: ‹h - (πA h + πB h) ∈ orthogonal_complement (A +⇩M B)›
by (metis IntI assms(2) assms(3) closed_csubspace_def complex_vector.subspace_def de_morgan_orthogonal_complement_plus)
from 1 2 show ‹h - (πA h + πB h) ∈ orthogonal_complement (A +⇩M B) ∧ πA h + πB h ∈ A +⇩M B›
by simp
qed
lemma projection_plus:
fixes A B :: "'a::chilbert_space set"
assumes "⋀x y. x:A ⟹ y:B ⟹ is_orthogonal x y"
assumes ‹closed_csubspace A›
assumes ‹closed_csubspace B›
shows ‹projection (A +⇩M B) = (λx. projection A x + projection B x)›
proof -
have ‹is_projection_on (λx. projection A x + projection B x) (A +⇩M B)›
apply (rule is_projection_on_plus)
using assms by auto
then show ?thesis
by (meson assms(2) assms(3) closed_csubspace.subspace closed_subspace_closed_sum csubspace_is_convex projection_eqI')
qed
lemma is_projection_on_insert:
assumes ortho: "⋀s. s ∈ S ⟹ ⟨a, s⟩ = 0"
assumes ‹is_projection_on π (closure (cspan S))›
assumes ‹is_projection_on πa (cspan {a})›
shows "is_projection_on (λx. πa x + π x) (closure (cspan (insert a S)))"
proof -
from ortho
have ‹x ∈ cspan {a} ⟹ y ∈ closure (cspan S) ⟹ is_orthogonal x y› for x y
using is_orthogonal_cspan is_orthogonal_closure is_orthogonal_sym
by (smt (verit, ccfv_threshold) empty_iff insert_iff)
then have ‹is_projection_on (λx. πa x + π x) (cspan {a} +⇩M closure (cspan S))›
apply (rule is_projection_on_plus)
using assms by (auto simp add: closed_csubspace.intro)
also have ‹… = closure (cspan (insert a S))›
using closed_sum_cspan[where X=‹{a}›] by simp
finally show ?thesis
by -
qed
lemma projection_insert:
fixes a :: ‹'a::chilbert_space›
assumes a1: "⋀s. s ∈ S ⟹ ⟨a, s⟩ = 0"
shows "projection (closure (cspan (insert a S))) u
= projection (cspan {a}) u + projection (closure (cspan S)) u"
using is_projection_on_insert[where S=S, OF a1]
by (metis (no_types, lifting) closed_closure closed_csubspace.intro closure_is_csubspace complex_vector.subspace_span csubspace_is_convex finite.intros(1) finite.intros(2) finite_cspan_closed_csubspace projection_eqI' projection_is_projection_on')
lemma projection_insert_finite:
assumes a1: "⋀s. s ∈ S ⟹ ⟨a, s⟩ = 0" and a2: "finite (S::'a::chilbert_space set)"
shows "projection (cspan (insert a S)) u
= projection (cspan {a}) u + projection (cspan S) u"
using projection_insert
by (metis a1 a2 closure_finite_cspan finite.insertI)
subsection ‹Canonical basis (‹onb_enum›)›
setup ‹Sign.add_const_constraint (\<^const_name>‹is_ortho_set›, SOME \<^typ>‹'a set ⇒ bool›)›
class onb_enum = basis_enum + complex_inner +
assumes is_orthonormal: "is_ortho_set (set canonical_basis)"
and is_normal: "⋀x. x ∈ (set canonical_basis) ⟹ norm x = 1"
setup ‹Sign.add_const_constraint (\<^const_name>‹is_ortho_set›, SOME \<^typ>‹'a::complex_inner set ⇒ bool›)›
lemma cinner_canonical_basis:
assumes ‹i < length (canonical_basis :: 'a::onb_enum list)›
assumes ‹j < length (canonical_basis :: 'a::onb_enum list)›
shows ‹cinner (canonical_basis!i :: 'a) (canonical_basis!j) = (if i=j then 1 else 0)›
by (metis assms(1) assms(2) distinct_canonical_basis is_normal is_ortho_set_def is_orthonormal nth_eq_iff_index_eq nth_mem of_real_1 power2_norm_eq_cinner power_one)
instance onb_enum ⊆ chilbert_space
proof
show "convergent X"
if "Cauchy X"
for X :: "nat ⇒ 'a"
proof-
have ‹finite (set canonical_basis)›
by simp
have ‹Cauchy (λ n. ⟨ t, X n ⟩)› for t
by (simp add: bounded_clinear.Cauchy bounded_clinear_cinner_right that)
hence ‹convergent (λ n. ⟨ t, X n ⟩)›
for t
by (simp add: Cauchy_convergent_iff)
hence ‹∀ t∈set canonical_basis. ∃ L. (λ n. ⟨ t, X n ⟩) ⇢ L›
by (simp add: convergentD)
hence ‹∃ L. ∀ t∈set canonical_basis. (λ n. ⟨ t, X n ⟩) ⇢ L t›
by metis
then obtain L where ‹⋀ t. t∈set canonical_basis ⟹ (λ n. ⟨ t, X n ⟩) ⇢ L t›
by blast
define l where ‹l = (∑t∈set canonical_basis. L t *⇩C t)›
have x1: ‹X n = (∑t∈set canonical_basis. ⟨ t, X n ⟩ *⇩C t)›
for n
using onb_expansion_finite[where T = "set canonical_basis" and x = "X n"]
‹finite (set canonical_basis)›
by (smt is_generator_set is_normal is_orthonormal)
have ‹(λ n. ⟨ t, X n ⟩ *⇩C t) ⇢ L t *⇩C t›
if r1: ‹t∈set canonical_basis›
for t
proof-
have ‹(λ n. ⟨ t, X n ⟩) ⇢ L t›
using r1 ‹⋀ t. t∈set canonical_basis ⟹ (λ n. ⟨ t, X n ⟩) ⇢ L t›
by blast
define f where ‹f x = x *⇩C t› for x
have ‹isCont f r›
for r
unfolding f_def
by (simp add: bounded_clinear_scaleC_left clinear_continuous_at)
hence ‹(λ n. f ⟨ t, X n ⟩) ⇢ f (L t)›
using ‹(λn. ⟨t, X n⟩) ⇢ L t› isCont_tendsto_compose by blast
hence ‹(λ n. ⟨ t, X n ⟩ *⇩C t) ⇢ L t *⇩C t›
unfolding f_def
by simp
thus ?thesis by blast
qed
hence ‹(λ n. (∑t∈set canonical_basis. ⟨ t, X n ⟩ *⇩C t))
⇢ (∑t∈set canonical_basis. L t *⇩C t)›
using ‹finite (set canonical_basis)›
tendsto_sum[where I = "set canonical_basis" and f = "λ t. λ n. ⟨t, X n⟩ *⇩C t"
and a = "λ t. L t *⇩C t"]
by auto
hence x2: ‹(λ n. (∑t∈set canonical_basis. ⟨ t, X n ⟩ *⇩C t)) ⇢ l›
using l_def by blast
have ‹X ⇢ l›
using x1 x2 by simp
thus ?thesis
unfolding convergent_def by blast
qed
qed
subsection ‹Conjugate space›
instantiation conjugate_space :: (complex_inner) complex_inner begin
lift_definition cinner_conjugate_space :: "'a conjugate_space ⇒ 'a conjugate_space ⇒ complex" is
‹λx y. cinner y x›.
instance
apply (intro_classes; transfer)
apply (simp_all add: )
apply (simp add: cinner_add_right)
using cinner_ge_zero norm_eq_sqrt_cinner by auto
end
instance conjugate_space :: (chilbert_space) chilbert_space..
end
Theory One_Dimensional_Spaces
section ‹‹One_Dimensional_Spaces› -- One dimensional complex vector spaces›
theory One_Dimensional_Spaces
imports
Complex_Inner_Product
"Complex_Bounded_Operators.Extra_Operator_Norm"
begin
text ‹The class ‹one_dim› applies to one-dimensional vector spaces.
Those are additionally interpreted as \<^class>‹complex_algebra_1›s
via the canonical isomorphism between a one-dimensional vector space and
\<^typ>‹complex›.›
class one_dim = onb_enum + one + times + complex_inner + inverse +
assumes one_dim_canonical_basis[simp]: "canonical_basis = [1]"
assumes one_dim_prod_scale1: "(a *⇩C 1) * (b *⇩C 1) = (a*b) *⇩C 1"
assumes divide_inverse: "x / y = x * inverse y"
assumes one_dim_inverse: "inverse (a *⇩C 1) = inverse a *⇩C 1"
hide_fact (open) divide_inverse
instance complex :: one_dim
apply intro_classes
unfolding canonical_basis_complex_def is_ortho_set_def
by (auto simp: divide_complex_def)
lemma one_cinner_one[simp]: ‹⟨(1::('a::one_dim)), 1⟩ = 1›
proof-
include notation_norm
have ‹(canonical_basis::'a list) = [1::('a::one_dim)]›
by (simp add: one_dim_canonical_basis)
hence ‹∥1::'a::one_dim∥ = 1›
by (metis is_normal list.set_intros(1))
hence ‹∥1::'a::one_dim∥^2 = 1›
by simp
moreover have ‹∥(1::('a::one_dim))∥^2 = ⟨(1::('a::one_dim)), 1⟩›
by (metis cnorm_eq_square)
ultimately show ?thesis by simp
qed
lemma one_cinner_a_scaleC_one[simp]: ‹⟨1::('a::one_dim), a⟩ *⇩C 1 = a›
proof-
have ‹(canonical_basis::'a list) = [1]›
by (simp add: one_dim_canonical_basis)
hence r2: ‹a ∈ complex_vector.span ({1::'a})›
using iso_tuple_UNIV_I empty_set is_generator_set list.simps(15)
by metis
have "(1::'a) ∉ {}"
by (metis equals0D)
hence r1: ‹∃ s. a = s *⇩C 1›
by (metis Diff_insert_absorb r2 complex_vector.span_breakdown
complex_vector.span_empty eq_iff_diff_eq_0 singleton_iff)
then obtain s where s_def: ‹a = s *⇩C 1›
by blast
have ‹⟨(1::'a), a⟩ = ⟨(1::'a), s *⇩C 1⟩›
using ‹a = s *⇩C 1›
by simp
also have ‹… = s * ⟨(1::'a), 1⟩›
by simp
also have ‹… = s›
using one_cinner_one by auto
finally show ?thesis
by (simp add: s_def)
qed
lemma one_dim_apply_is_times_def:
"ψ * φ = (⟨1, ψ⟩ * ⟨1, φ⟩) *⇩C 1" for ψ :: ‹'a::one_dim›
by (metis one_cinner_a_scaleC_one one_dim_prod_scale1)
instance one_dim ⊆ complex_algebra_1
proof
fix x y z :: ‹'a::one_dim› and c :: complex
show "(x * y) * z = x * (y * z)"
by (simp add: one_dim_apply_is_times_def[where ?'a='a])
show "(x + y) * z = x * z + y * z"
by (metis (no_types, lifting) cinner_simps(2) complex_vector.vector_space_assms(2) complex_vector.vector_space_assms(3) one_dim_apply_is_times_def)
show "x * (y + z) = x * y + x * z"
by (metis (mono_tags, lifting) cinner_simps(2) complex_vector.vector_space_assms(2) distrib_left one_dim_apply_is_times_def)
show "(c *⇩C x) * y = c *⇩C (x * y)"
by (simp add: one_dim_apply_is_times_def[where ?'a='a])
show "x * (c *⇩C y) = c *⇩C (x * y)"
by (simp add: one_dim_apply_is_times_def[where ?'a='a])
show "1 * x = x"
by (metis mult.left_neutral one_cinner_a_scaleC_one one_cinner_one one_dim_apply_is_times_def)
show "x * 1 = x"
by (simp add: one_dim_apply_is_times_def [where ?'a = 'a])
show "(0::'a) ≠ 1"
by (metis cinner_eq_zero_iff one_cinner_one zero_neq_one)
qed
instance one_dim ⊆ complex_normed_algebra
proof
fix x y :: ‹'a::one_dim›
show "norm (x * y) ≤ norm x * norm y"
proof-
have r1: "cmod (⟨1::'a, x⟩) ≤ norm (1::'a) * norm x"
by (simp add: complex_inner_class.Cauchy_Schwarz_ineq2)
have r2: "cmod (⟨1::'a, y⟩) ≤ norm (1::'a) * norm y"
by (simp add: complex_inner_class.Cauchy_Schwarz_ineq2)
have q1: "⟨(1::'a), 1⟩ = 1"
by (simp add: )
hence "(norm (1::'a))^2 = 1"
by (simp add: cnorm_eq_1 power2_eq_1_iff)
hence "norm (1::'a) = 1"
by (smt abs_norm_cancel power2_eq_1_iff)
hence "cmod (⟨1::'a, x⟩ * ⟨1::'a, y⟩) * norm (1::'a) = cmod (⟨1::'a, x⟩ * ⟨1::'a, y⟩)"
by simp
also have "… = cmod (⟨1::'a, x⟩) * cmod (⟨1::'a, y⟩)"
by (simp add: norm_mult)
also have "… ≤ norm (1::'a) * norm x * norm (1::'a) * norm y"
by (smt ‹norm 1 = 1› mult.commute mult_cancel_right1 norm_scaleC one_cinner_a_scaleC_one)
also have "… = norm x * norm y"
by (simp add: ‹norm 1 = 1›)
finally show ?thesis
by (simp add: one_dim_apply_is_times_def[where ?'a='a])
qed
qed
instance one_dim ⊆ complex_normed_algebra_1
proof intro_classes
show "norm (1::'a) = 1"
by (metis complex_inner_1_left norm_eq_sqrt_cinner norm_one one_cinner_one)
qed
text ‹This is the canonical isomorphism between any two one dimensional spaces. Specifically,
if 1 denotes the element of the canonical basis (which is specified by type class \<^class>‹basis_enum›,
then \<^term>‹one_dim_iso› is the unique isomorphism that maps 1 to 1.›
definition one_dim_iso :: "'a::one_dim ⇒ 'b::one_dim"
where "one_dim_iso a = of_complex (⟨1, a⟩)"
lemma one_dim_iso_idem[simp]: "one_dim_iso (one_dim_iso x) = one_dim_iso x"
by (simp add: one_dim_iso_def)
lemma one_dim_iso_id[simp]: "one_dim_iso = id"
unfolding one_dim_iso_def
by (auto simp add: of_complex_def)
lemma one_dim_iso_adjoint[simp]: ‹cadjoint one_dim_iso = one_dim_iso›
apply (rule cadjoint_eqI)
by (simp add: one_dim_iso_def of_complex_def)
lemma one_dim_iso_is_of_complex[simp]: "one_dim_iso = of_complex"
unfolding one_dim_iso_def by auto
lemma of_complex_one_dim_iso[simp]: "of_complex (one_dim_iso ψ) = one_dim_iso ψ"
by (metis one_dim_iso_is_of_complex one_dim_iso_idem)
lemma one_dim_iso_of_complex[simp]: "one_dim_iso (of_complex c) = of_complex c"
by (metis one_dim_iso_is_of_complex one_dim_iso_idem)
lemma one_dim_iso_add[simp]:
‹one_dim_iso (a + b) = one_dim_iso a + one_dim_iso b›
by (simp add: cinner_simps(2) one_dim_iso_def)
lemma one_dim_iso_minus[simp]:
‹one_dim_iso (a - b) = one_dim_iso a - one_dim_iso b›
by (simp add: cinner_simps(3) one_dim_iso_def)
lemma one_dim_iso_scaleC[simp]: "one_dim_iso (c *⇩C ψ) = c *⇩C one_dim_iso ψ"
by (metis cinner_scaleC_right of_complex_mult one_dim_iso_def scaleC_conv_of_complex)
lemma clinear_one_dim_iso[simp]: "clinear one_dim_iso"
by (rule clinearI, auto)
lemma bounded_clinear_one_dim_iso[simp]: "bounded_clinear one_dim_iso"
proof (rule bounded_clinear_intro [where K = 1] , auto)
fix x :: ‹'a::one_dim›
show "norm (one_dim_iso x) ≤ norm x"
by (metis (full_types) norm_of_complex of_complex_def one_cinner_a_scaleC_one one_dim_iso_def
order_refl)
qed
lemma one_dim_iso_of_one[simp]: "one_dim_iso 1 = 1"
by (simp add: one_dim_iso_def)
lemma onorm_one_dim_iso[simp]: "onorm one_dim_iso = 1"
proof (rule onormI [where b = 1 and x = 1])
fix x :: ‹'a::one_dim›
have "norm (one_dim_iso x ::'b) ≤ norm x"
by (metis eq_iff norm_of_complex of_complex_def one_cinner_a_scaleC_one one_dim_iso_def)
thus "norm (one_dim_iso (x::'a)::'b) ≤ 1 * norm x"
by auto
show "(1::'a) ≠ 0"
by simp
show "norm (one_dim_iso (1::'a)::'b) = 1 * norm (1::'a)"
by auto
qed
lemma one_dim_iso_times[simp]: "one_dim_iso (ψ * φ) = one_dim_iso ψ * one_dim_iso φ"
by (metis mult.left_neutral mult_scaleC_left of_complex_def one_cinner_a_scaleC_one one_dim_iso_def one_dim_iso_scaleC)
lemma one_dim_iso_of_zero[simp]: "one_dim_iso 0 = 0"
by (simp add: complex_vector.linear_0)
lemma one_dim_iso_of_zero': "one_dim_iso x = 0 ⟹ x = 0"
by (metis of_complex_def of_complex_eq_0_iff one_cinner_a_scaleC_one one_dim_iso_def)
lemma one_dim_scaleC_1[simp]: "one_dim_iso x *⇩C 1 = x"
by (simp add: one_dim_iso_def)
lemma one_dim_clinear_eqI:
assumes "(x::'a::one_dim) ≠ 0" and "clinear f" and "clinear g" and "f x = g x"
shows "f = g"
proof (rule ext)
fix y :: 'a
from ‹f x = g x›
have ‹one_dim_iso x *⇩C f 1 = one_dim_iso x *⇩C g 1›
by (metis assms(2) assms(3) complex_vector.linear_scale one_dim_scaleC_1)
hence "f 1 = g 1"
using assms(1) one_dim_iso_of_zero' by auto
then show "f y = g y"
by (metis assms(2) assms(3) complex_vector.linear_scale one_dim_scaleC_1)
qed
lemma one_dim_norm: "norm x = cmod (one_dim_iso x)"
proof (subst one_dim_scaleC_1 [symmetric])
show "norm (one_dim_iso x *⇩C (1::'a)) = cmod (one_dim_iso x)"
by (metis norm_of_complex of_complex_def)
qed
lemma one_dim_onorm:
fixes f :: "'a::one_dim ⇒ 'b::complex_normed_vector"
assumes "clinear f"
shows "onorm f = norm (f 1)"
proof (rule onormI[where x=1])
fix x :: 'a
have "norm x * norm (f 1) ≤ norm (f 1) * norm x"
by simp
hence "norm (f (one_dim_iso x *⇩C 1)) ≤ norm (f 1) * norm x"
by (metis (mono_tags, lifting) assms complex_vector.linear_scale norm_scaleC one_dim_norm)
thus "norm (f x) ≤ norm (f 1) * norm x"
by (subst one_dim_scaleC_1 [symmetric])
qed auto
lemma one_dim_onorm':
fixes f :: "'a::one_dim ⇒ 'b::one_dim"
assumes "clinear f"
shows "onorm f = cmod (one_dim_iso (f 1))"
using assms one_dim_norm one_dim_onorm by fastforce
instance one_dim ⊆ zero_neq_one ..
lemma one_dim_iso_inj: "one_dim_iso x = one_dim_iso y ⟹ x = y"
by (metis one_dim_iso_idem one_dim_scaleC_1)
instance one_dim ⊆ comm_ring
proof intro_classes
fix x y z :: 'a
show "x * y = y * x"
by (metis one_dim_apply_is_times_def ordered_field_class.sign_simps(5))
show "(x + y) * z = x * z + y * z"
by (simp add: ring_class.ring_distribs(2))
qed
instance one_dim ⊆ field
proof intro_classes
fix x y z :: ‹'a::one_dim›
show "1 * x = x"
by simp
have "(inverse ⟨1, x⟩ * ⟨1, x⟩) *⇩C (1::'a) = 1" if "x ≠ 0"
by (metis left_inverse of_complex_def one_cinner_a_scaleC_one one_dim_iso_of_zero
one_dim_iso_is_of_complex one_dim_iso_of_one that)
hence "inverse (⟨1, x⟩ *⇩C 1) * ⟨1, x⟩ *⇩C 1 = (1::'a)" if "x ≠ 0"
by (metis one_dim_inverse one_dim_prod_scale1 that)
hence "inverse (⟨1, x⟩ *⇩C 1) * x = 1" if "x ≠ 0"
using one_cinner_a_scaleC_one[of x, symmetric] that by auto
thus "inverse x * x = 1" if "x ≠ 0"
by (simp add: that)
show "x / y = x * inverse y"
by (simp add: one_dim_class.divide_inverse)
show "inverse (0::'a) = 0"
by (subst complex_vector.scale_zero_left[symmetric], subst one_dim_inverse, simp)
qed
instance one_dim ⊆ complex_normed_field
proof intro_classes
fix x y :: 'a
show "norm (x * y) = norm x * norm y"
by (metis norm_mult one_dim_iso_times one_dim_norm)
qed
instance one_dim ⊆ chilbert_space..
end
Theory Complex_Euclidean_Space0
section ‹‹Complex_Euclidean_Space0› -- Finite-Dimensional Inner Product Spaces›
theory Complex_Euclidean_Space0
imports
"HOL-Analysis.L2_Norm"
"Complex_Inner_Product"
"HOL-Analysis.Product_Vector"
"HOL-Library.Rewrite"
begin
subsection ‹Type class of Euclidean spaces›
class ceuclidean_space = complex_inner +
fixes CBasis :: "'a set"
assumes nonempty_CBasis [simp]: "CBasis ≠ {}"
assumes finite_CBasis [simp]: "finite CBasis"
assumes cinner_CBasis:
"⟦u ∈ CBasis; v ∈ CBasis⟧ ⟹ cinner u v = (if u = v then 1 else 0)"
assumes ceuclidean_all_zero_iff:
"(∀u∈CBasis. cinner x u = 0) ⟷ (x = 0)"
syntax "_type_cdimension" :: "type ⇒ nat" ("(1CDIM/(1'(_')))")
translations "CDIM('a)" ⇀ "CONST card (CONST CBasis :: 'a set)"
typed_print_translation ‹
[(\<^const_syntax>‹card›,
fn ctxt => fn _ => fn [Const (\<^const_syntax>‹CBasis›, Type (\<^type_name>‹set›, [T]))] =>
Syntax.const \<^syntax_const>‹_type_cdimension› $ Syntax_Phases.term_of_typ ctxt T)]
›
lemma (in ceuclidean_space) norm_CBasis[simp]: "u ∈ CBasis ⟹ norm u = 1"
unfolding norm_eq_sqrt_cinner by (simp add: cinner_CBasis)
lemma (in ceuclidean_space) cinner_same_CBasis[simp]: "u ∈ CBasis ⟹ cinner u u = 1"
by (simp add: cinner_CBasis)
lemma (in ceuclidean_space) cinner_not_same_CBasis: "u ∈ CBasis ⟹ v ∈ CBasis ⟹ u ≠ v ⟹ cinner u v = 0"
by (simp add: cinner_CBasis)
lemma (in ceuclidean_space) sgn_CBasis: "u ∈ CBasis ⟹ sgn u = u"
unfolding sgn_div_norm by (simp add: scaleR_one)
lemma (in ceuclidean_space) CBasis_zero [simp]: "0 ∉ CBasis"
proof
assume "0 ∈ CBasis" thus "False"
using cinner_CBasis [of 0 0] by simp
qed
lemma (in ceuclidean_space) nonzero_CBasis: "u ∈ CBasis ⟹ u ≠ 0"
by clarsimp
lemma (in ceuclidean_space) SOME_CBasis: "(SOME i. i ∈ CBasis) ∈ CBasis"
by (metis ex_in_conv nonempty_CBasis someI_ex)
lemma norm_some_CBasis [simp]: "norm (SOME i. i ∈ CBasis) = 1"
by (simp add: SOME_CBasis)
lemma (in ceuclidean_space) cinner_sum_left_CBasis[simp]:
"b ∈ CBasis ⟹ cinner (∑i∈CBasis. f i *⇩C i) b = cnj (f b)"
by (simp add: cinner_sum_left cinner_CBasis if_distrib comm_monoid_add_class.sum.If_cases)
lemma (in ceuclidean_space) ceuclidean_eqI:
assumes b: "⋀b. b ∈ CBasis ⟹ cinner x b = cinner y b" shows "x = y"
proof -
from b have "∀b∈CBasis. cinner (x - y) b = 0"
by (simp add: cinner_diff_left)
then show "x = y"
by (simp add: ceuclidean_all_zero_iff)
qed
lemma (in ceuclidean_space) ceuclidean_eq_iff:
"x = y ⟷ (∀b∈CBasis. cinner x b = cinner y b)"
by (auto intro: ceuclidean_eqI)
lemma (in ceuclidean_space) ceuclidean_representation_sum:
"(∑i∈CBasis. f i *⇩C i) = b ⟷ (∀i∈CBasis. f i = cnj (cinner b i))"
apply (subst ceuclidean_eq_iff)
apply simp by (metis complex_cnj_cnj cinner_commute)
lemma (in ceuclidean_space) ceuclidean_representation_sum':
"b = (∑i∈CBasis. f i *⇩C i) ⟷ (∀i∈CBasis. f i = cinner i b)"
apply (auto simp add: ceuclidean_representation_sum[symmetric])
apply (metis ceuclidean_representation_sum cinner_commute)
by (metis local.ceuclidean_representation_sum local.cinner_commute)
lemma (in ceuclidean_space) ceuclidean_representation: "(∑b∈CBasis. cinner b x *⇩C b) = x"
unfolding ceuclidean_representation_sum
using local.cinner_commute by blast
lemma (in ceuclidean_space) ceuclidean_cinner: "cinner x y = (∑b∈CBasis. cinner x b * cnj (cinner y b))"
apply (subst (1 2) ceuclidean_representation [symmetric])
apply (simp add: cinner_sum_right cinner_CBasis ac_simps)
by (metis local.cinner_commute mult.commute)
lemma (in ceuclidean_space) choice_CBasis_iff:
fixes P :: "'a ⇒ complex ⇒ bool"
shows "(∀i∈CBasis. ∃x. P i x) ⟷ (∃x. ∀i∈CBasis. P i (cinner x i))"
unfolding bchoice_iff
proof safe
fix f assume "∀i∈CBasis. P i (f i)"
then show "∃x. ∀i∈CBasis. P i (cinner x i)"
by (auto intro!: exI[of _ "∑i∈CBasis. cnj (f i) *⇩C i"])
qed auto
lemma (in ceuclidean_space) bchoice_CBasis_iff:
fixes P :: "'a ⇒ complex ⇒ bool"
shows "(∀i∈CBasis. ∃x∈A. P i x) ⟷ (∃x. ∀i∈CBasis. cinner x i ∈ A ∧ P i (cinner x i))"
by (simp add: choice_CBasis_iff Bex_def)
lemma (in ceuclidean_space) ceuclidean_representation_sum_fun:
"(λx. ∑b∈CBasis. cinner b (f x) *⇩C b) = f"
apply (rule ext)
apply (simp add: ceuclidean_representation_sum)
by (meson local.cinner_commute)
lemma euclidean_isCont:
assumes "⋀b. b ∈ CBasis ⟹ isCont (λx. (cinner b (f x)) *⇩C b) x"
shows "isCont f x"
apply (subst ceuclidean_representation_sum_fun [symmetric])
apply (rule isCont_sum)
by (blast intro: assms)
lemma CDIM_positive [simp]: "0 < CDIM('a::ceuclidean_space)"
by (simp add: card_gt_0_iff)
lemma CDIM_ge_Suc0 [simp]: "Suc 0 ≤ card CBasis"
by (meson CDIM_positive Suc_leI)
lemma sum_cinner_CBasis_scaleC [simp]:
fixes f :: "'a::ceuclidean_space ⇒ 'b::complex_vector"
assumes "b ∈ CBasis" shows "(∑i∈CBasis. (cinner i b) *⇩C f i) = f b"
by (simp add: comm_monoid_add_class.sum.remove [OF finite_CBasis assms]
assms cinner_not_same_CBasis comm_monoid_add_class.sum.neutral)
lemma sum_cinner_CBasis_eq [simp]:
assumes "b ∈ CBasis" shows "(∑i∈CBasis. (cinner i b) * f i) = f b"
by (simp add: comm_monoid_add_class.sum.remove [OF finite_CBasis assms]
assms cinner_not_same_CBasis comm_monoid_add_class.sum.neutral)
lemma sum_if_cinner [simp]:
assumes "i ∈ CBasis" "j ∈ CBasis"
shows "cinner (∑k∈CBasis. if k = i then f i *⇩C i else g k *⇩C k) j = (if j=i then cnj (f j) else cnj (g j))"
proof (cases "i=j")
case True
with assms show ?thesis
by (auto simp: cinner_sum_left if_distrib [of "λx. cinner x j"] cinner_CBasis cong: if_cong)
next
case False
have "(∑k∈CBasis. cinner (if k = i then f i *⇩C i else g k *⇩C k) j) =
(∑k∈CBasis. if k = j then cnj (g k) else 0)"
apply (rule sum.cong)
using False assms by (auto simp: cinner_CBasis)
also have "... = cnj (g j)"
using assms by auto
finally show ?thesis
using False by (auto simp: cinner_sum_left)
qed
lemma norm_le_componentwise:
"(⋀b. b ∈ CBasis ⟹ cmod(cinner x b) ≤ cmod(cinner y b)) ⟹ norm x ≤ norm y"
apply (auto simp: cnorm_le ceuclidean_cinner [of x x] ceuclidean_cinner [of y y] power2_eq_square intro!: sum_mono)
apply (smt (verit, best) mult.commute sum.cong)
by (simp add: ordered_field_class.sign_simps(33))
lemma CBasis_le_norm: "b ∈ CBasis ⟹ cmod (cinner x b) ≤ norm x"
by (rule order_trans [OF Cauchy_Schwarz_ineq2]) simp
lemma norm_bound_CBasis_le: "b ∈ CBasis ⟹ norm x ≤ e ⟹ cmod (inner x b) ≤ e"
by (metis inner_commute mult.left_neutral norm_CBasis norm_of_real order_trans real_inner_class.Cauchy_Schwarz_ineq2)
lemma norm_bound_CBasis_lt: "b ∈ CBasis ⟹ norm x < e ⟹ cmod (inner x b) < e"
by (metis inner_commute le_less_trans mult.left_neutral norm_CBasis norm_of_real real_inner_class.Cauchy_Schwarz_ineq2)
lemma cnorm_le_l1: "norm x ≤ (∑b∈CBasis. cmod (cinner x b))"
apply (subst ceuclidean_representation[of x, symmetric])
apply (rule order_trans[OF norm_sum])
apply (auto intro!: sum_mono)
by (metis cinner_commute complex_inner_1_left complex_inner_class.Cauchy_Schwarz_ineq2 mult.commute mult.left_neutral norm_one)
subsection ‹Class instances›
subsubsection ‹Type \<^typ>‹complex››
instantiation complex :: ceuclidean_space
begin
definition
[simp]: "CBasis = {1::complex}"
instance
by standard auto
end
lemma CDIM_complex[simp]: "CDIM(complex) = 1"
by simp
subsubsection ‹Type \<^typ>‹'a × 'b››
instantiation prod :: (complex_inner, complex_inner) complex_inner
begin
definition cinner_prod_def:
"cinner x y = cinner (fst x) (fst y) + cinner (snd x) (snd y)"
lemma cinner_Pair [simp]: "cinner (a, b) (c, d) = cinner a c + cinner b d"
unfolding cinner_prod_def by simp
instance
proof
fix r :: complex
fix x y z :: "'a::complex_inner × 'b::complex_inner"
show "cinner x y = cnj (cinner y x)"
unfolding cinner_prod_def
by simp
show "cinner (x + y) z = cinner x z + cinner y z"
unfolding cinner_prod_def
by (simp add: cinner_add_left)
show "cinner (scaleC r x) y = cnj r * cinner x y"
unfolding cinner_prod_def
by (simp add: distrib_left)
show "0 ≤ cinner x x"
unfolding cinner_prod_def
by (intro add_nonneg_nonneg cinner_ge_zero)
show "cinner x x = 0 ⟷ x = 0"
unfolding cinner_prod_def prod_eq_iff
by (metis antisym cinner_eq_zero_iff cinner_ge_zero fst_zero le_add_same_cancel2 snd_zero verit_sum_simplify)
show "norm x = sqrt (cmod (cinner x x))"
unfolding norm_prod_def cinner_prod_def
by (metis (no_types, lifting) Re_complex_of_real add_nonneg_nonneg cinner_ge_zero complex_of_real_cmod plus_complex.simps(1) power2_norm_eq_cinner')
qed
end
lemma cinner_Pair_0: "cinner x (0, b) = cinner (snd x) b" "cinner x (a, 0) = cinner (fst x) a"
by (cases x, simp)+
instantiation prod :: (ceuclidean_space, ceuclidean_space) ceuclidean_space
begin
definition
"CBasis = (λu. (u, 0)) ` CBasis ∪ (λv. (0, v)) ` CBasis"
lemma sum_CBasis_prod_eq:
fixes f::"('a*'b)⇒('a*'b)"
shows "sum f CBasis = sum (λi. f (i, 0)) CBasis + sum (λi. f (0, i)) CBasis"
proof -
have "inj_on (λu. (u::'a, 0::'b)) CBasis" "inj_on (λu. (0::'a, u::'b)) CBasis"
by (auto intro!: inj_onI Pair_inject)
thus ?thesis
unfolding CBasis_prod_def
by (subst sum.union_disjoint) (auto simp: CBasis_prod_def sum.reindex)
qed
instance proof
show "(CBasis :: ('a × 'b) set) ≠ {}"
unfolding CBasis_prod_def by simp
next
show "finite (CBasis :: ('a × 'b) set)"
unfolding CBasis_prod_def by simp
next
fix u v :: "'a × 'b"
assume "u ∈ CBasis" and "v ∈ CBasis"
thus "cinner u v = (if u = v then 1 else 0)"
unfolding CBasis_prod_def cinner_prod_def
by (auto simp add: cinner_CBasis split: if_split_asm)
next
fix x :: "'a × 'b"
show "(∀u∈CBasis. cinner x u = 0) ⟷ x = 0"
unfolding CBasis_prod_def ball_Un ball_simps
by (simp add: cinner_prod_def prod_eq_iff ceuclidean_all_zero_iff)
qed
lemma CDIM_prod[simp]: "CDIM('a × 'b) = CDIM('a) + CDIM('b)"
unfolding CBasis_prod_def
by (subst card_Un_disjoint) (auto intro!: card_image arg_cong2[where f="(+)"] inj_onI)
end
subsection ‹Locale instances›
lemma finite_dimensional_vector_space_euclidean:
"finite_dimensional_vector_space (*⇩C) CBasis"
proof unfold_locales
show "finite (CBasis::'a set)" by (metis finite_CBasis)
show "complex_vector.independent (CBasis::'a set)"
unfolding complex_vector.dependent_def cdependent_raw_def[symmetric]
apply (subst complex_vector.span_finite)
apply simp
apply clarify
apply (drule_tac f="cinner a" in arg_cong)
by (simp add: cinner_CBasis cinner_sum_right eq_commute)
show "module.span (*⇩C) CBasis = UNIV"
unfolding complex_vector.span_finite [OF finite_CBasis] cspan_raw_def[symmetric]
by (auto intro!: ceuclidean_representation[symmetric])
qed
interpretation ceucl: finite_dimensional_vector_space "scaleC :: complex => 'a => 'a::ceuclidean_space" "CBasis"
rewrites "module.dependent (*⇩C) = cdependent"
and "module.representation (*⇩C) = crepresentation"
and "module.subspace (*⇩C) = csubspace"
and "module.span (*⇩C) = cspan"
and "vector_space.extend_basis (*⇩C) = cextend_basis"
and "vector_space.dim (*⇩C) = cdim"
and "Vector_Spaces.linear (*⇩C) (*⇩C) = clinear"
and "Vector_Spaces.linear (*) (*⇩C) = clinear"
and "finite_dimensional_vector_space.dimension CBasis = CDIM('a)"
by (auto simp add: cdependent_raw_def crepresentation_raw_def
csubspace_raw_def cspan_raw_def cextend_basis_raw_def cdim_raw_def clinear_def
complex_scaleC_def[abs_def]
finite_dimensional_vector_space.dimension_def
intro!: finite_dimensional_vector_space.dimension_def
finite_dimensional_vector_space_euclidean)
interpretation ceucl: finite_dimensional_vector_space_pair_1
"scaleC::complex⇒'a::ceuclidean_space⇒'a" CBasis
"scaleC::complex⇒'b::complex_vector ⇒ 'b"
by unfold_locales
interpretation ceucl?: finite_dimensional_vector_space_prod scaleC scaleC CBasis CBasis
rewrites "Basis_pair = CBasis"
and "module_prod.scale (*⇩C) (*⇩C) = (scaleC::_⇒_⇒('a × 'b))"
proof -
show "finite_dimensional_vector_space_prod (*⇩C) (*⇩C) CBasis CBasis"
by unfold_locales
interpret finite_dimensional_vector_space_prod "(*⇩C)" "(*⇩C)" "CBasis::'a set" "CBasis::'b set"
by fact
show "Basis_pair = CBasis"
unfolding Basis_pair_def CBasis_prod_def by auto
show "module_prod.scale (*⇩C) (*⇩C) = scaleC"
by (fact module_prod_scale_eq_scaleC)
qed
end
Theory Complex_Bounded_Linear_Function0
section ‹‹Complex_Bounded_Linear_Function0› -- Bounded Linear Function›
theory Complex_Bounded_Linear_Function0
imports
"HOL-Analysis.Bounded_Linear_Function"
Complex_Inner_Product
Complex_Euclidean_Space0
begin
unbundle cinner_syntax
lemma conorm_componentwise:
assumes "bounded_clinear f"
shows "onorm f ≤ (∑i∈CBasis. norm (f i))"
proof -
{
fix i::'a
assume "i ∈ CBasis"
hence "onorm (λx. (i ∙⇩C x) *⇩C f i) ≤ onorm (λx. (i ∙⇩C x)) * norm (f i)"
by (auto intro!: onorm_scaleC_left_lemma bounded_clinear_cinner_right)
also have "… ≤ norm i * norm (f i)"
apply (rule mult_right_mono)
apply (simp add: complex_inner_class.Cauchy_Schwarz_ineq2 onorm_bound)
by simp
finally have "onorm (λx. (i ∙⇩C x) *⇩C f i) ≤ norm (f i)" using ‹i ∈ CBasis›
by simp
} hence "onorm (λx. ∑i∈CBasis. (i ∙⇩C x) *⇩C f i) ≤ (∑i∈CBasis. norm (f i))"
by (auto intro!: order_trans[OF onorm_sum_le] bounded_clinear_scaleC_const
sum_mono bounded_clinear_cinner_right bounded_clinear.bounded_linear)
also have "(λx. ∑i∈CBasis. (i ∙⇩C x) *⇩C f i) = (λx. f (∑i∈CBasis. (i ∙⇩C x) *⇩C i))"
by (simp add: clinear.scaleC linear_sum bounded_clinear.clinear clinear.linear assms)
also have "… = f"
by (simp add: ceuclidean_representation)
finally show ?thesis .
qed
lemmas conorm_componentwise_le = order_trans[OF conorm_componentwise]
subsection ‹Intro rules for \<^term>‹bounded_linear››
lemma onorm_cinner_left:
assumes "bounded_linear r"
shows "onorm (λx. r x ∙⇩C f) ≤ onorm r * norm f"
proof (rule onorm_bound)
fix x
have "norm (r x ∙⇩C f) ≤ norm (r x) * norm f"
by (simp add: Cauchy_Schwarz_ineq2)
also have "… ≤ onorm r * norm x * norm f"
by (simp add: assms mult.commute mult_left_mono onorm)
finally show "norm (r x ∙⇩C f) ≤ onorm r * norm f * norm x"
by (simp add: ac_simps)
qed (intro mult_nonneg_nonneg norm_ge_zero onorm_pos_le assms)
lemma onorm_cinner_right:
assumes "bounded_linear r"
shows "onorm (λx. f ∙⇩C r x) ≤ norm f * onorm r"
proof (rule onorm_bound)
fix x
have "norm (f ∙⇩C r x) ≤ norm f * norm (r x)"
by (simp add: Cauchy_Schwarz_ineq2)
also have "… ≤ onorm r * norm x * norm f"
by (simp add: assms mult.commute mult_left_mono onorm)
finally show "norm (f ∙⇩C r x) ≤ norm f * onorm r * norm x"
by (simp add: ac_simps)
qed (intro mult_nonneg_nonneg norm_ge_zero onorm_pos_le assms)
lemmas [bounded_linear_intros] =
bounded_clinear_zero
bounded_clinear_add
bounded_clinear_const_mult
bounded_clinear_mult_const
bounded_clinear_scaleC_const
bounded_clinear_const_scaleC
bounded_clinear_const_scaleR
bounded_clinear_ident
bounded_clinear_sum
bounded_clinear_sub
bounded_antilinear_cinner_left_comp
bounded_clinear_cinner_right_comp
subsection ‹declaration of derivative/continuous/tendsto introduction rules for bounded linear functions›
attribute_setup bounded_clinear =
‹let val bounded_linear = Attrib.attribute \<^context> (the_single @{attributes [bounded_linear]}) in
Scan.succeed (Thm.declaration_attribute (fn thm =>
Thm.attribute_declaration bounded_linear (thm RS @{thm bounded_clinear.bounded_linear}) o
fold (fn (r, s) => Named_Theorems.add_thm s (thm RS r))
[
(@{thm bounded_clinear_compose}, \<^named_theorems>‹bounded_linear_intros›),
(@{thm bounded_clinear_o_bounded_antilinear[unfolded o_def]}, \<^named_theorems>‹bounded_linear_intros›)
]))
end›
attribute_setup bounded_antilinear =
‹let val bounded_linear = Attrib.attribute \<^context> (the_single @{attributes [bounded_linear]}) in
Scan.succeed (Thm.declaration_attribute (fn thm =>
Thm.attribute_declaration bounded_linear (thm RS @{thm bounded_antilinear.bounded_linear}) o
fold (fn (r, s) => Named_Theorems.add_thm s (thm RS r))
[
(@{thm bounded_antilinear_o_bounded_clinear[unfolded o_def]}, \<^named_theorems>‹bounded_linear_intros›),
(@{thm bounded_antilinear_o_bounded_antilinear[unfolded o_def]}, \<^named_theorems>‹bounded_linear_intros›)
]))
end›
attribute_setup bounded_cbilinear =
‹let val bounded_bilinear = Attrib.attribute \<^context> (the_single @{attributes [bounded_bilinear]}) in
Scan.succeed (Thm.declaration_attribute (fn thm =>
Thm.attribute_declaration bounded_bilinear (thm RS @{thm bounded_cbilinear.bounded_bilinear}) o
fold (fn (r, s) => Named_Theorems.add_thm s (thm RS r))
[
(@{thm bounded_clinear_compose[OF bounded_cbilinear.bounded_clinear_left]},
\<^named_theorems>‹bounded_linear_intros›),
(@{thm bounded_clinear_compose[OF bounded_cbilinear.bounded_clinear_right]},
\<^named_theorems>‹bounded_linear_intros›),
(@{thm bounded_clinear_o_bounded_antilinear[unfolded o_def, OF bounded_cbilinear.bounded_clinear_left]},
\<^named_theorems>‹bounded_linear_intros›),
(@{thm bounded_clinear_o_bounded_antilinear[unfolded o_def, OF bounded_cbilinear.bounded_clinear_right]},
\<^named_theorems>‹bounded_linear_intros›)
]))
end›
attribute_setup bounded_sesquilinear =
‹let val bounded_bilinear = Attrib.attribute \<^context> (the_single @{attributes [bounded_bilinear]}) in
Scan.succeed (Thm.declaration_attribute (fn thm =>
Thm.attribute_declaration bounded_bilinear (thm RS @{thm bounded_sesquilinear.bounded_bilinear}) o
fold (fn (r, s) => Named_Theorems.add_thm s (thm RS r))
[
(@{thm bounded_antilinear_o_bounded_clinear[unfolded o_def, OF bounded_sesquilinear.bounded_antilinear_left]},
\<^named_theorems>‹bounded_linear_intros›),
(@{thm bounded_clinear_compose[OF bounded_sesquilinear.bounded_clinear_right]},
\<^named_theorems>‹bounded_linear_intros›),
(@{thm bounded_antilinear_o_bounded_antilinear[unfolded o_def, OF bounded_sesquilinear.bounded_antilinear_left]},
\<^named_theorems>‹bounded_linear_intros›),
(@{thm bounded_clinear_o_bounded_antilinear[unfolded o_def, OF bounded_sesquilinear.bounded_clinear_right]},
\<^named_theorems>‹bounded_linear_intros›)
]))
end›
subsection ‹Type of complex bounded linear functions›
typedef (overloaded) ('a, 'b) cblinfun ("(_ ⇒⇩C⇩L /_)" [22, 21] 21) =
"{f::'a::complex_normed_vector⇒'b::complex_normed_vector. bounded_clinear f}"
morphisms cblinfun_apply CBlinfun
by (blast intro: bounded_linear_intros)
declare [[coercion
"cblinfun_apply :: ('a::complex_normed_vector ⇒⇩C⇩L'b::complex_normed_vector) ⇒ 'a ⇒ 'b"]]
lemma bounded_clinear_cblinfun_apply[bounded_linear_intros]:
"bounded_clinear g ⟹ bounded_clinear (λx. cblinfun_apply f (g x))"
by (metis cblinfun_apply mem_Collect_eq bounded_clinear_compose)
setup_lifting type_definition_cblinfun
lemma cblinfun_eqI: "(⋀i. cblinfun_apply x i = cblinfun_apply y i) ⟹ x = y"
by transfer auto
lemma bounded_clinear_CBlinfun_apply: "bounded_clinear f ⟹ cblinfun_apply (CBlinfun f) = f"
by (auto simp: CBlinfun_inverse)
subsection ‹Type class instantiations›
instantiation cblinfun :: (complex_normed_vector, complex_normed_vector) complex_normed_vector
begin
lift_definition norm_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ real" is onorm .
lift_definition minus_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b"
is "λf g x. f x - g x"
by (rule bounded_clinear_sub)
definition dist_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b ⇒ real"
where "dist_cblinfun a b = norm (a - b)"
definition [code del]:
"(uniformity :: (('a ⇒⇩C⇩L 'b) × ('a ⇒⇩C⇩L 'b)) filter) = (INF e∈{0 <..}. principal {(x, y). dist x y < e})"
definition open_cblinfun :: "('a ⇒⇩C⇩L 'b) set ⇒ bool"
where [code del]: "open_cblinfun S = (∀x∈S. ∀⇩F (x', y) in uniformity. x' = x ⟶ y ∈ S)"
lift_definition uminus_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b" is "λf x. - f x"
by (rule bounded_clinear_minus)
lift_definition zero_cblinfun :: "'a ⇒⇩C⇩L 'b" is "λx. 0"
by (rule bounded_clinear_zero)
lift_definition plus_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b"
is "λf g x. f x + g x"
by (metis bounded_clinear_add)
lift_definition scaleC_cblinfun::"complex ⇒ 'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b" is "λr f x. r *⇩C f x"
by (metis bounded_clinear_compose bounded_clinear_scaleC_right)
lift_definition scaleR_cblinfun::"real ⇒ 'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b" is "λr f x. r *⇩R f x"
by (rule bounded_clinear_const_scaleR)
definition sgn_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b"
where "sgn_cblinfun x = scaleC (inverse (norm x)) x"
instance
proof
fix a b c :: "'a ⇒⇩C⇩L'b" and r q :: real and s t :: complex
show ‹a + b + c = a + (b + c)›
apply transfer by auto
show ‹0 + a = a›
apply transfer by auto
show ‹a + b = b + a›
apply transfer by auto
show ‹- a + a = 0›
apply transfer by auto
show ‹a - b = a + - b›
apply transfer by auto
show scaleR_scaleC: ‹((*⇩R) r::('a ⇒⇩C⇩L 'b) ⇒ _) = (*⇩C) (complex_of_real r)› for r
apply (rule ext, transfer fixing: r) by (simp add: scaleR_scaleC)
show ‹s *⇩C (b + c) = s *⇩C b + s *⇩C c›
apply transfer by (simp add: scaleC_add_right)
show ‹(s + t) *⇩C a = s *⇩C a + t *⇩C a›
apply transfer by (simp add: scaleC_left.add)
show ‹s *⇩C t *⇩C a = (s * t) *⇩C a›
apply transfer by auto
show ‹1 *⇩C a = a›
apply transfer by auto
show ‹dist a b = norm (a - b)›
unfolding dist_cblinfun_def by simp
show ‹sgn a = (inverse (norm a)) *⇩R a›
unfolding sgn_cblinfun_def unfolding scaleR_scaleC by auto
show ‹uniformity = (INF e∈{0<..}. principal {(x, y). dist (x::('a ⇒⇩C⇩L 'b)) y < e})›
by (simp add: uniformity_cblinfun_def)
show ‹open U = (∀x∈U. ∀⇩F (x', y) in uniformity. (x'::('a ⇒⇩C⇩L 'b)) = x ⟶ y ∈ U)› for U
by (simp add: open_cblinfun_def)
show ‹(norm a = 0) = (a = 0)›
apply transfer using bounded_clinear.bounded_linear onorm_eq_0 by blast
show ‹norm (a + b) ≤ norm a + norm b›
apply transfer by (simp add: bounded_clinear.bounded_linear onorm_triangle)
show ‹norm (s *⇩C a) = cmod s * norm a›
apply transfer using onorm_scalarC by blast
show ‹norm (r *⇩R a) = ¦r¦ * norm a›
apply transfer using bounded_clinear.bounded_linear onorm_scaleR by blast
show ‹r *⇩R (a + b) = r *⇩R a + r *⇩R b›
apply transfer by (simp add: scaleR_add_right)
show ‹(r + q) *⇩R a = r *⇩R a + q *⇩R a›
apply transfer by (simp add: scaleR_add_left)
show ‹r *⇩R q *⇩R a = (r * q) *⇩R a›
apply transfer by auto
show ‹1 *⇩R a = a›
apply transfer by auto
qed
end
declare uniformity_Abort[where 'a="('a :: complex_normed_vector) ⇒⇩C⇩L ('b :: complex_normed_vector)", code]
lemma norm_cblinfun_eqI:
assumes "n ≤ norm (cblinfun_apply f x) / norm x"
assumes "⋀x. norm (cblinfun_apply f x) ≤ n * norm x"
assumes "0 ≤ n"
shows "norm f = n"
by (auto simp: norm_cblinfun_def
intro!: antisym onorm_bound assms order_trans[OF _ le_onorm] bounded_clinear.bounded_linear
bounded_linear_intros)
lemma norm_cblinfun: "norm (cblinfun_apply f x) ≤ norm f * norm x"
apply transfer by (simp add: bounded_clinear.bounded_linear onorm)
lemma norm_cblinfun_bound: "0 ≤ b ⟹ (⋀x. norm (cblinfun_apply f x) ≤ b * norm x) ⟹ norm f ≤ b"
by transfer (rule onorm_bound)
lemma bounded_cbilinear_cblinfun_apply[bounded_cbilinear]: "bounded_cbilinear cblinfun_apply"
proof
fix f g::"'a ⇒⇩C⇩L 'b" and a b::'a and r::complex
show "(f + g) a = f a + g a" "(r *⇩C f) a = r *⇩C f a"
by (transfer, simp)+
interpret bounded_clinear f for f::"'a ⇒⇩C⇩L 'b"
by (auto intro!: bounded_linear_intros)
show "f (a + b) = f a + f b" "f (r *⇩C a) = r *⇩C f a"
by (simp_all add: add scaleC)
show "∃K. ∀a b. norm (cblinfun_apply a b) ≤ norm a * norm b * K"
by (auto intro!: exI[where x=1] norm_cblinfun)
qed
interpretation cblinfun: bounded_cbilinear cblinfun_apply
by (rule bounded_cbilinear_cblinfun_apply)
lemmas bounded_clinear_apply_cblinfun[intro, simp] = cblinfun.bounded_clinear_left
declare cblinfun.zero_left [simp] cblinfun.zero_right [simp]
context bounded_cbilinear
begin
named_theorems cbilinear_simps
lemmas [cbilinear_simps] =
add_left
add_right
diff_left
diff_right
minus_left
minus_right
scaleC_left
scaleC_right
zero_left
zero_right
sum_left
sum_right
end
instance cblinfun :: (complex_normed_vector, cbanach) cbanach
proof
fix X::"nat ⇒ 'a ⇒⇩C⇩L 'b"
assume "Cauchy X"
{
fix x::'a
{
fix x::'a
assume "norm x ≤ 1"
have "Cauchy (λn. X n x)"
proof (rule CauchyI)
fix e::real
assume "0 < e"
from CauchyD[OF ‹Cauchy X› ‹0 < e›] obtain M
where M: "⋀m n. m ≥ M ⟹ n ≥ M ⟹ norm (X m - X n) < e"
by auto
show "∃M. ∀m≥M. ∀n≥M. norm (X m x - X n x) < e"
proof (safe intro!: exI[where x=M])
fix m n
assume le: "M ≤ m" "M ≤ n"
have "norm (X m x - X n x) = norm ((X m - X n) x)"
by (simp add: cblinfun.cbilinear_simps)
also have "… ≤ norm (X m - X n) * norm x"
by (rule norm_cblinfun)
also have "… ≤ norm (X m - X n) * 1"
using ‹norm x ≤ 1› norm_ge_zero by (rule mult_left_mono)
also have "… = norm (X m - X n)" by simp
also have "… < e" using le by fact
finally show "norm (X m x - X n x) < e" .
qed
qed
hence "convergent (λn. X n x)"
by (metis Cauchy_convergent_iff)
} note convergent_norm1 = this
define y where "y = x /⇩R norm x"
have y: "norm y ≤ 1" and xy: "x = norm x *⇩R y"
by (simp_all add: y_def inverse_eq_divide)
have "convergent (λn. norm x *⇩R X n y)"
by (intro bounded_bilinear.convergent[OF bounded_bilinear_scaleR] convergent_const
convergent_norm1 y)
also have "(λn. norm x *⇩R X n y) = (λn. X n x)"
by (metis cblinfun.scaleC_right scaleR_scaleC xy)
finally have "convergent (λn. X n x)" .
}
then obtain v where v: "⋀x. (λn. X n x) ⇢ v x"
unfolding convergent_def
by metis
have "Cauchy (λn. norm (X n))"
proof (rule CauchyI)
fix e::real
assume "e > 0"
from CauchyD[OF ‹Cauchy X› ‹0 < e›] obtain M
where M: "⋀m n. m ≥ M ⟹ n ≥ M ⟹ norm (X m - X n) < e"
by auto
show "∃M. ∀m≥M. ∀n≥M. norm (norm (X m) - norm (X n)) < e"
proof (safe intro!: exI[where x=M])
fix m n assume mn: "m ≥ M" "n ≥ M"
have "norm (norm (X m) - norm (X n)) ≤ norm (X m - X n)"
by (metis norm_triangle_ineq3 real_norm_def)
also have "… < e" using mn by fact
finally show "norm (norm (X m) - norm (X n)) < e" .
qed
qed
then obtain K where K: "(λn. norm (X n)) ⇢ K"
unfolding Cauchy_convergent_iff convergent_def
by metis
have "bounded_clinear v"
proof
fix x y and r::complex
from tendsto_add[OF v[of x] v [of y]] v[of "x + y", unfolded cblinfun.cbilinear_simps]
tendsto_scaleC[OF tendsto_const[of r] v[of x]] v[of "r *⇩C x", unfolded cblinfun.cbilinear_simps]
show "v (x + y) = v x + v y" "v (r *⇩C x) = r *⇩C v x"
by (metis (poly_guards_query) LIMSEQ_unique)+
show "∃K. ∀x. norm (v x) ≤ norm x * K"
proof (safe intro!: exI[where x=K])
fix x
have "norm (v x) ≤ K * norm x"
apply (rule tendsto_le[OF _ tendsto_mult[OF K tendsto_const] tendsto_norm[OF v]])
by (auto simp: norm_cblinfun)
thus "norm (v x) ≤ norm x * K"
by (simp add: ac_simps)
qed
qed
hence Bv: "⋀x. (λn. X n x) ⇢ CBlinfun v x"
by (auto simp: bounded_clinear_CBlinfun_apply v)
have "X ⇢ CBlinfun v"
proof (rule LIMSEQ_I)
fix r::real assume "r > 0"
define r' where "r' = r / 2"
have "0 < r'" "r' < r" using ‹r > 0› by (simp_all add: r'_def)
from CauchyD[OF ‹Cauchy X› ‹r' > 0›]
obtain M where M: "⋀m n. m ≥ M ⟹ n ≥ M ⟹ norm (X m - X n) < r'"
by metis
show "∃no. ∀n≥no. norm (X n - CBlinfun v) < r"
proof (safe intro!: exI[where x=M])
fix n assume n: "M ≤ n"
have "norm (X n - CBlinfun v) ≤ r'"
proof (rule norm_cblinfun_bound)
fix x
have "eventually (λm. m ≥ M) sequentially"
by (metis eventually_ge_at_top)
hence ev_le: "eventually (λm. norm (X n x - X m x) ≤ r' * norm x) sequentially"
proof eventually_elim
case (elim m)
have "norm (X n x - X m x) = norm ((X n - X m) x)"
by (simp add: cblinfun.cbilinear_simps)
also have "… ≤ norm ((X n - X m)) * norm x"
by (rule norm_cblinfun)
also have "… ≤ r' * norm x"
using M[OF n elim] by (simp add: mult_right_mono)
finally show ?case .
qed
have tendsto_v: "(λm. norm (X n x - X m x)) ⇢ norm (X n x - CBlinfun v x)"
by (auto intro!: tendsto_intros Bv)
show "norm ((X n - CBlinfun v) x) ≤ r' * norm x"
by (auto intro!: tendsto_upperbound tendsto_v ev_le simp: cblinfun.cbilinear_simps)
qed (simp add: ‹0 < r'› less_imp_le)
thus "norm (X n - CBlinfun v) < r"
by (metis ‹r' < r› le_less_trans)
qed
qed
thus "convergent X"
by (rule convergentI)
qed
subsection ‹On Euclidean Space›
lemma norm_cblinfun_ceuclidean_le:
fixes a::"'a::ceuclidean_space ⇒⇩C⇩L 'b::complex_normed_vector"
shows "norm a ≤ sum (λx. norm (a x)) CBasis"
apply (rule norm_cblinfun_bound)
apply (simp add: sum_nonneg)
apply (subst ceuclidean_representation[symmetric, where 'a='a])
apply (simp only: cblinfun.cbilinear_simps sum_distrib_right)
apply (rule order.trans[OF norm_sum sum_mono])
apply (simp add: abs_mult mult_right_mono ac_simps CBasis_le_norm)
by (metis complex_inner_class.Cauchy_Schwarz_ineq2 mult.commute mult.left_neutral mult_right_mono norm_CBasis norm_ge_zero)
lemma ctendsto_componentwise1:
fixes a::"'a::ceuclidean_space ⇒⇩C⇩L 'b::complex_normed_vector"
and b::"'c ⇒ 'a ⇒⇩C⇩L 'b"
assumes "(⋀j. j ∈ CBasis ⟹ ((λn. b n j) ⤏ a j) F)"
shows "(b ⤏ a) F"
proof -
have "⋀j. j ∈ CBasis ⟹ Zfun (λx. norm (b x j - a j)) F"
using assms unfolding tendsto_Zfun_iff Zfun_norm_iff .
hence "Zfun (λx. ∑j∈CBasis. norm (b x j - a j)) F"
by (auto intro!: Zfun_sum)
thus ?thesis
unfolding tendsto_Zfun_iff
by (rule Zfun_le)
(auto intro!: order_trans[OF norm_cblinfun_ceuclidean_le] simp: cblinfun.cbilinear_simps)
qed
lift_definition
cblinfun_of_matrix::"('b::ceuclidean_space ⇒ 'a::ceuclidean_space ⇒ complex) ⇒ 'a ⇒⇩C⇩L 'b"
is "λa x. ∑i∈CBasis. ∑j∈CBasis. ((j ∙⇩C x) * a i j) *⇩C i"
by (intro bounded_linear_intros)
lemma cblinfun_of_matrix_works:
fixes f::"'a::ceuclidean_space ⇒⇩C⇩L 'b::ceuclidean_space"
shows "cblinfun_of_matrix (λi j. i ∙⇩C (f j)) = f"
proof (transfer, rule, rule ceuclidean_eqI)
fix f::"'a ⇒ 'b" and x::'a and b::'b assume "bounded_clinear f" and b: "b ∈ CBasis"
then interpret bounded_clinear f by simp
have "(∑j∈CBasis. ∑i∈CBasis. (i ∙⇩C x * (j ∙⇩C f i)) *⇩C j) ∙⇩C b
= (∑j∈CBasis. if j = b then (∑i∈CBasis. (x ∙⇩C i * (f i ∙⇩C j))) else 0)"
using b
apply (simp add: cinner_sum_left cinner_CBasis if_distrib cong: if_cong)
by (simp add: sum.swap)
also have "… = (∑i∈CBasis. ((x ∙⇩C i) * (f i ∙⇩C b)))"
using b by (simp)
also have "… = f x ∙⇩C b"
proof -
have ‹(∑i∈CBasis. (x ∙⇩C i) * (f i ∙⇩C b)) = (∑i∈CBasis. (i ∙⇩C x) *⇩C f i) ∙⇩C b›
by (auto simp: cinner_sum_left)
also have ‹… = f x ∙⇩C b›
by (simp add: ceuclidean_representation sum[symmetric] scale[symmetric])
finally show ?thesis by -
qed
finally show "(∑j∈CBasis. ∑i∈CBasis. (i ∙⇩C x * (j ∙⇩C f i)) *⇩C j) ∙⇩C b = f x ∙⇩C b" .
qed
lemma cblinfun_of_matrix_apply:
"cblinfun_of_matrix a x = (∑i∈CBasis. ∑j∈CBasis. ((j ∙⇩C x) * a i j) *⇩C i)"
apply transfer by simp
lemma cblinfun_of_matrix_minus: "cblinfun_of_matrix x - cblinfun_of_matrix y = cblinfun_of_matrix (x - y)"
by transfer (auto simp: algebra_simps sum_subtractf)
lemma norm_cblinfun_of_matrix:
"norm (cblinfun_of_matrix a) ≤ (∑i∈CBasis. ∑j∈CBasis. cmod (a i j))"
apply (rule norm_cblinfun_bound)
apply (simp add: sum_nonneg)
apply (simp only: cblinfun_of_matrix_apply sum_distrib_right)
apply (rule order_trans[OF norm_sum sum_mono])
apply (rule order_trans[OF norm_sum sum_mono])
apply (simp add: abs_mult mult_right_mono ac_simps Basis_le_norm)
by (metis complex_inner_class.Cauchy_Schwarz_ineq2 complex_scaleC_def mult.left_neutral mult_right_mono norm_CBasis norm_ge_zero norm_scaleC)
lemma tendsto_cblinfun_of_matrix:
assumes "⋀i j. i ∈ CBasis ⟹ j ∈ CBasis ⟹ ((λn. b n i j) ⤏ a i j) F"
shows "((λn. cblinfun_of_matrix (b n)) ⤏ cblinfun_of_matrix a) F"
proof -
have "⋀i j. i ∈ CBasis ⟹ j ∈ CBasis ⟹ Zfun (λx. norm (b x i j - a i j)) F"
using assms unfolding tendsto_Zfun_iff Zfun_norm_iff .
hence "Zfun (λx. (∑i∈CBasis. ∑j∈CBasis. cmod (b x i j - a i j))) F"
by (auto intro!: Zfun_sum)
thus ?thesis
unfolding tendsto_Zfun_iff cblinfun_of_matrix_minus
by (rule Zfun_le) (auto intro!: order_trans[OF norm_cblinfun_of_matrix])
qed
lemma ctendsto_componentwise:
fixes a::"'a::ceuclidean_space ⇒⇩C⇩L 'b::ceuclidean_space"
and b::"'c ⇒ 'a ⇒⇩C⇩L 'b"
shows "(⋀i j. i ∈ CBasis ⟹ j ∈ CBasis ⟹ ((λn. b n j ∙⇩C i) ⤏ a j ∙⇩C i) F) ⟹ (b ⤏ a) F"
apply (subst cblinfun_of_matrix_works[of a, symmetric])
apply (subst cblinfun_of_matrix_works[of "b x" for x, symmetric, abs_def])
apply (rule tendsto_cblinfun_of_matrix)
apply (subst (1) cinner_commute, subst (2) cinner_commute)
by (metis lim_cnj)
lemma
continuous_cblinfun_componentwiseI:
fixes f:: "'b::t2_space ⇒ 'a::ceuclidean_space ⇒⇩C⇩L 'c::ceuclidean_space"
assumes "⋀i j. i ∈ CBasis ⟹ j ∈ CBasis ⟹ continuous F (λx. (f x) j ∙⇩C i)"
shows "continuous F f"
using assms by (auto simp: continuous_def intro!: ctendsto_componentwise)
lemma
continuous_cblinfun_componentwiseI1:
fixes f:: "'b::t2_space ⇒ 'a::ceuclidean_space ⇒⇩C⇩L 'c::complex_normed_vector"
assumes "⋀i. i ∈ CBasis ⟹ continuous F (λx. f x i)"
shows "continuous F f"
using assms by (auto simp: continuous_def intro!: ctendsto_componentwise1)
lemma
continuous_on_cblinfun_componentwise:
fixes f:: "'d::t2_space ⇒ 'e::ceuclidean_space ⇒⇩C⇩L 'f::complex_normed_vector"
assumes "⋀i. i ∈ CBasis ⟹ continuous_on s (λx. f x i)"
shows "continuous_on s f"
using assms
by (auto intro!: continuous_at_imp_continuous_on intro!: ctendsto_componentwise1
simp: continuous_on_eq_continuous_within continuous_def)
lemma bounded_antilinear_cblinfun_matrix: "bounded_antilinear (λx. (x::_⇒⇩C⇩L _) j ∙⇩C i)"
by (auto intro!: bounded_linear_intros)
lemma continuous_cblinfun_matrix:
fixes f:: "'b::t2_space ⇒ 'a::complex_normed_vector ⇒⇩C⇩L 'c::complex_inner"
assumes "continuous F f"
shows "continuous F (λx. (f x) j ∙⇩C i)"
by (rule bounded_antilinear.continuous[OF bounded_antilinear_cblinfun_matrix assms])
lemma continuous_on_cblinfun_matrix:
fixes f::"'a::t2_space ⇒ 'b::complex_normed_vector ⇒⇩C⇩L 'c::complex_inner"
assumes "continuous_on S f"
shows "continuous_on S (λx. (f x) j ∙⇩C i)"
using assms
by (auto simp: continuous_on_eq_continuous_within continuous_cblinfun_matrix)
lemma continuous_on_cblinfun_of_matrix[continuous_intros]:
assumes "⋀i j. i ∈ CBasis ⟹ j ∈ CBasis ⟹ continuous_on S (λs. g s i j)"
shows "continuous_on S (λs. cblinfun_of_matrix (g s))"
using assms
by (auto simp: continuous_on intro!: tendsto_cblinfun_of_matrix)
lemma cblinfun_euclidean_eqI: "(⋀i. i ∈ CBasis ⟹ cblinfun_apply x i = cblinfun_apply y i) ⟹ x = y"
apply (auto intro!: cblinfun_eqI)
apply (subst (2) ceuclidean_representation[symmetric, where 'a='a])
apply (subst (1) ceuclidean_representation[symmetric, where 'a='a])
by (simp add: cblinfun.cbilinear_simps)
lemma CBlinfun_eq_matrix: "bounded_clinear f ⟹ CBlinfun f = cblinfun_of_matrix (λi j. i ∙⇩C f j)"
apply (intro cblinfun_euclidean_eqI)
by (auto simp: cblinfun_of_matrix_apply bounded_clinear_CBlinfun_apply cinner_CBasis if_distrib
if_distribR sum.delta' ceuclidean_representation
cong: if_cong)
subsection ‹concrete bounded linear functions›
lemma transfer_bounded_cbilinear_bounded_clinearI:
assumes "g = (λi x. (cblinfun_apply (f i) x))"
shows "bounded_cbilinear g = bounded_clinear f"
proof
assume "bounded_cbilinear g"
then interpret bounded_cbilinear f by (simp add: assms)
show "bounded_clinear f"
proof (unfold_locales, safe intro!: cblinfun_eqI)
fix i
show "f (x + y) i = (f x + f y) i" "f (r *⇩C x) i = (r *⇩C f x) i" for r x y
by (auto intro!: cblinfun_eqI simp: cblinfun.cbilinear_simps)
from _ nonneg_bounded show "∃K. ∀x. norm (f x) ≤ norm x * K"
by (rule ex_reg) (auto intro!: onorm_bound simp: norm_cblinfun.rep_eq ac_simps)
qed
qed (auto simp: assms intro!: cblinfun.comp)
lemma transfer_bounded_cbilinear_bounded_clinear[transfer_rule]:
"(rel_fun (rel_fun (=) (pcr_cblinfun (=) (=))) (=)) bounded_cbilinear bounded_clinear"
by (auto simp: pcr_cblinfun_def cr_cblinfun_def rel_fun_def OO_def
intro!: transfer_bounded_cbilinear_bounded_clinearI)
lemma transfer_bounded_sesquilinear_bounded_antilinearI:
assumes "g = (λi x. (cblinfun_apply (f i) x))"
shows "bounded_sesquilinear g = bounded_antilinear f"
proof
assume "bounded_sesquilinear g"
then interpret bounded_sesquilinear f by (simp add: assms)
show "bounded_antilinear f"
proof (unfold_locales, safe intro!: cblinfun_eqI)
fix i
show "f (x + y) i = (f x + f y) i" "f (r *⇩C x) i = (cnj r *⇩C f x) i" for r x y
by (auto intro!: cblinfun_eqI simp: cblinfun.scaleC_left scaleC_left add_left cblinfun.add_left)
from _ nonneg_bounded show "∃K. ∀x. norm (f x) ≤ norm x * K"
by (rule ex_reg) (auto intro!: onorm_bound simp: norm_cblinfun.rep_eq ac_simps)
qed
next
assume "bounded_antilinear f"
then obtain K where K: ‹norm (f x) ≤ norm x * K› for x
using bounded_antilinear.bounded by blast
have ‹norm (cblinfun_apply (f a) b) ≤ norm (f a) * norm b› for a b
by (simp add: norm_cblinfun)
also have ‹… a b ≤ norm a * norm b * K› for a b
by (smt (verit, best) K mult.assoc mult.commute mult_mono' norm_ge_zero)
finally have *: ‹norm (cblinfun_apply (f a) b) ≤ norm a * norm b * K› for a b
by simp
show "bounded_sesquilinear g"
using ‹bounded_antilinear f›
apply (auto intro!: bounded_sesquilinear.intro simp: assms cblinfun.add_left cblinfun.add_right
linear_simps bounded_antilinear.bounded_linear antilinear.scaleC bounded_antilinear.antilinear
cblinfun.scaleC_left cblinfun.scaleC_right)
using * by blast
qed
lemma transfer_bounded_sesquilinear_bounded_antilinear[transfer_rule]:
"(rel_fun (rel_fun (=) (pcr_cblinfun (=) (=))) (=)) bounded_sesquilinear bounded_antilinear"
by (auto simp: pcr_cblinfun_def cr_cblinfun_def rel_fun_def OO_def
intro!: transfer_bounded_sesquilinear_bounded_antilinearI)
context bounded_cbilinear
begin
lift_definition prod_left::"'b ⇒ 'a ⇒⇩C⇩L 'c" is "(λb a. prod a b)"
by (rule bounded_clinear_left)
declare prod_left.rep_eq[simp]
lemma bounded_clinear_prod_left[bounded_clinear]: "bounded_clinear prod_left"
by transfer (rule flip)
lift_definition prod_right::"'a ⇒ 'b ⇒⇩C⇩L 'c" is "(λa b. prod a b)"
by (rule bounded_clinear_right)
declare prod_right.rep_eq[simp]
lemma bounded_clinear_prod_right[bounded_clinear]: "bounded_clinear prod_right"
by transfer (rule bounded_cbilinear_axioms)
end
lift_definition id_cblinfun::"'a::complex_normed_vector ⇒⇩C⇩L 'a" is "λx. x"
by (rule bounded_clinear_ident)
lemmas cblinfun_id_cblinfun_apply[simp] = id_cblinfun.rep_eq
lemma norm_cblinfun_id[simp]:
"norm (id_cblinfun::'a::{complex_normed_vector, not_singleton} ⇒⇩C⇩L 'a) = 1"
apply transfer
apply (rule onorm_id[internalize_sort' 'a])
apply standard[1]
by simp
lemma norm_blinfun_id_le:
"norm (id_cblinfun::'a::complex_normed_vector ⇒⇩C⇩L 'a) ≤ 1"
by transfer (auto simp: onorm_id_le)
lift_definition cblinfun_compose::
"'a::complex_normed_vector ⇒⇩C⇩L 'b::complex_normed_vector ⇒
'c::complex_normed_vector ⇒⇩C⇩L 'a ⇒
'c ⇒⇩C⇩L 'b" (infixl "o⇩C⇩L" 55) is "(o)"
parametric comp_transfer
unfolding o_def
by (rule bounded_clinear_compose)
lemma cblinfun_apply_cblinfun_compose[simp]: "(a o⇩C⇩L b) c = a (b c)"
by (simp add: cblinfun_compose.rep_eq)
lemma norm_cblinfun_compose:
"norm (f o⇩C⇩L g) ≤ norm f * norm g"
apply transfer
by (auto intro!: onorm_compose simp: bounded_clinear.bounded_linear)
lemma bounded_cbilinear_cblinfun_compose[bounded_cbilinear]: "bounded_cbilinear (o⇩C⇩L)"
by unfold_locales
(auto intro!: cblinfun_eqI exI[where x=1] simp: cblinfun.cbilinear_simps norm_cblinfun_compose)
lemma cblinfun_compose_zero[simp]:
"blinfun_compose 0 = (λ_. 0)"
"blinfun_compose x 0 = 0"
by (auto simp: blinfun.bilinear_simps intro!: blinfun_eqI)
lemma cblinfun_bij2:
fixes f::"'a ⇒⇩C⇩L 'a::ceuclidean_space"
assumes "f o⇩C⇩L g = id_cblinfun"
shows "bij (cblinfun_apply g)"
proof (rule bijI)
show "inj g"
using assms
by (metis cblinfun_id_cblinfun_apply cblinfun_compose.rep_eq injI inj_on_imageI2)
then show "surj g"
using bounded_clinear_def cblinfun.bounded_clinear_right ceucl.linear_inj_imp_surj by blast
qed
lemma cblinfun_bij1:
fixes f::"'a ⇒⇩C⇩L 'a::ceuclidean_space"
assumes "f o⇩C⇩L g = id_cblinfun"
shows "bij (cblinfun_apply f)"
proof (rule bijI)
show "surj (cblinfun_apply f)"
by (metis assms cblinfun_apply_cblinfun_compose cblinfun_id_cblinfun_apply surjI)
then show "inj (cblinfun_apply f)"
using bounded_clinear_def cblinfun.bounded_clinear_right ceucl.linear_surjective_imp_injective by blast
qed
lift_definition cblinfun_cinner_right::"'a::complex_inner ⇒ 'a ⇒⇩C⇩L complex" is "(∙⇩C)"
by (rule bounded_clinear_cinner_right)
declare cblinfun_cinner_right.rep_eq[simp]
lemma bounded_antilinear_cblinfun_cinner_right[bounded_antilinear]: "bounded_antilinear cblinfun_cinner_right"
apply transfer by (simp add: bounded_sesquilinear_cinner)
lift_definition cblinfun_scaleC_right::"complex ⇒ 'a ⇒⇩C⇩L 'a::complex_normed_vector" is "(*⇩C)"
by (rule bounded_clinear_scaleC_right)
declare cblinfun_scaleC_right.rep_eq[simp]
lemma bounded_clinear_cblinfun_scaleC_right[bounded_clinear]: "bounded_clinear cblinfun_scaleC_right"
by transfer (rule bounded_cbilinear_scaleC)
lift_definition cblinfun_scaleC_left::"'a::complex_normed_vector ⇒ complex ⇒⇩C⇩L 'a" is "λx y. y *⇩C x"
by (rule bounded_clinear_scaleC_left)
lemmas [simp] = cblinfun_scaleC_left.rep_eq
lemma bounded_clinear_cblinfun_scaleC_left[bounded_clinear]: "bounded_clinear cblinfun_scaleC_left"
by transfer (rule bounded_cbilinear.flip[OF bounded_cbilinear_scaleC])
lift_definition cblinfun_mult_right::"'a ⇒ 'a ⇒⇩C⇩L 'a::complex_normed_algebra" is "(*)"
by (rule bounded_clinear_mult_right)
declare cblinfun_mult_right.rep_eq[simp]
lemma bounded_clinear_cblinfun_mult_right[bounded_clinear]: "bounded_clinear cblinfun_mult_right"
by transfer (rule bounded_cbilinear_mult)
lift_definition cblinfun_mult_left::"'a::complex_normed_algebra ⇒ 'a ⇒⇩C⇩L 'a" is "λx y. y * x"
by (rule bounded_clinear_mult_left)
lemmas [simp] = cblinfun_mult_left.rep_eq
lemma bounded_clinear_cblinfun_mult_left[bounded_clinear]: "bounded_clinear cblinfun_mult_left"
by transfer (rule bounded_cbilinear.flip[OF bounded_cbilinear_mult])
lemmas bounded_clinear_function_uniform_limit_intros[uniform_limit_intros] =
bounded_clinear.uniform_limit[OF bounded_clinear_apply_cblinfun]
bounded_clinear.uniform_limit[OF bounded_clinear_cblinfun_apply]
bounded_antilinear.uniform_limit[OF bounded_antilinear_cblinfun_matrix]
subsection ‹The strong operator topology on continuous linear operators›
text ‹Let ‹'a› and ‹'b› be two normed real vector spaces. Then the space of linear continuous
operators from ‹'a› to ‹'b› has a canonical norm, and therefore a canonical corresponding topology
(the type classes instantiation are given in 🗏‹Complex_Bounded_Linear_Function0.thy›).
However, there is another topology on this space, the strong operator topology, where ‹T⇩n› tends to
‹T› iff, for all ‹x› in ‹'a›, then ‹T⇩n x› tends to ‹T x›. This is precisely the product topology
where the target space is endowed with the norm topology. It is especially useful when ‹'b› is the set
of real numbers, since then this topology is compact.
We can not implement it using type classes as there is already a topology, but at least we
can define it as a topology.
Note that there is yet another (common and useful) topology on operator spaces, the weak operator
topology, defined analogously using the product topology, but where the target space is given the
weak-* topology, i.e., the pullback of the weak topology on the bidual of the space under the
canonical embedding of a space into its bidual. We do not define it there, although it could also be
defined analogously.
›
definition cstrong_operator_topology::"('a::complex_normed_vector ⇒⇩C⇩L'b::complex_normed_vector) topology"
where "cstrong_operator_topology = pullback_topology UNIV cblinfun_apply euclidean"
lemma cstrong_operator_topology_topspace:
"topspace cstrong_operator_topology = UNIV"
unfolding cstrong_operator_topology_def topspace_pullback_topology topspace_euclidean by auto
lemma cstrong_operator_topology_basis:
fixes f::"('a::complex_normed_vector ⇒⇩C⇩L'b::complex_normed_vector)" and U::"'i ⇒ 'b set" and x::"'i ⇒ 'a"
assumes "finite I" "⋀i. i ∈ I ⟹ open (U i)"
shows "openin cstrong_operator_topology {f. ∀i∈I. cblinfun_apply f (x i) ∈ U i}"
proof -
have "open {g::('a⇒'b). ∀i∈I. g (x i) ∈ U i}"
by (rule product_topology_basis'[OF assms])
moreover have "{f. ∀i∈I. cblinfun_apply f (x i) ∈ U i}
= cblinfun_apply-`{g::('a⇒'b). ∀i∈I. g (x i) ∈ U i} ∩ UNIV"
by auto
ultimately show ?thesis
unfolding cstrong_operator_topology_def by (subst openin_pullback_topology) auto
qed
lemma cstrong_operator_topology_continuous_evaluation:
"continuous_map cstrong_operator_topology euclidean (λf. cblinfun_apply f x)"
proof -
have "continuous_map cstrong_operator_topology euclidean ((λf. f x) o cblinfun_apply)"
unfolding cstrong_operator_topology_def apply (rule continuous_map_pullback)
using continuous_on_product_coordinates by fastforce
then show ?thesis unfolding comp_def by simp
qed
lemma continuous_on_cstrong_operator_topo_iff_coordinatewise:
"continuous_map T cstrong_operator_topology f
⟷ (∀x. continuous_map T euclidean (λy. cblinfun_apply (f y) x))"
proof (auto)
fix x::"'b"
assume "continuous_map T cstrong_operator_topology f"
with continuous_map_compose[OF this cstrong_operator_topology_continuous_evaluation]
have "continuous_map T euclidean ((λz. cblinfun_apply z x) o f)"
by simp
then show "continuous_map T euclidean (λy. cblinfun_apply (f y) x)"
unfolding comp_def by auto
next
assume *: "∀x. continuous_map T euclidean (λy. cblinfun_apply (f y) x)"
have "⋀i. continuous_map T euclidean (λx. cblinfun_apply (f x) i)"
using * unfolding comp_def by auto
then have "continuous_map T euclidean (cblinfun_apply o f)"
unfolding o_def
by (metis (no_types) continuous_map_componentwise_UNIV euclidean_product_topology)
show "continuous_map T cstrong_operator_topology f"
unfolding cstrong_operator_topology_def
apply (rule continuous_map_pullback')
by (auto simp add: ‹continuous_map T euclidean (cblinfun_apply o f)›)
qed
lemma cstrong_operator_topology_weaker_than_euclidean:
"continuous_map euclidean cstrong_operator_topology (λf. f)"
apply (subst continuous_on_cstrong_operator_topo_iff_coordinatewise)
by (auto simp add: linear_continuous_on continuous_at_imp_continuous_on linear_continuous_at
bounded_clinear.bounded_linear)
end
Theory Complex_Bounded_Linear_Function
section ‹‹Complex_Bounded_Linear_Function› -- Complex bounded linear functions (bounded operators)›
theory Complex_Bounded_Linear_Function
imports
Complex_Inner_Product One_Dimensional_Spaces
Banach_Steinhaus.Banach_Steinhaus
"HOL-Types_To_Sets.Types_To_Sets"
Complex_Bounded_Linear_Function0
begin
subsection ‹Misc basic facts and declarations›
notation cblinfun_apply (infixr "*⇩V" 70)
lemma id_cblinfun_apply[simp]: "id_cblinfun *⇩V ψ = ψ"
apply transfer by simp
lemma isCont_cblinfun_apply[simp]: "isCont ((*⇩V) A) ψ"
apply transfer
by (simp add: clinear_continuous_at)
declare cblinfun.scaleC_left[simp]
lemma cblinfun_apply_clinear[simp]: ‹clinear (cblinfun_apply A)›
using bounded_clinear.axioms(1) cblinfun_apply by blast
lemma cblinfun_cinner_eqI:
fixes A B :: ‹'a::chilbert_space ⇒⇩C⇩L 'a›
assumes ‹⋀ψ. cinner ψ (A *⇩V ψ) = cinner ψ (B *⇩V ψ)›
shows ‹A = B›
proof -
define C where ‹C = A - B›
have C0[simp]: ‹cinner ψ (C ψ) = 0› for ψ
by (simp add: C_def assms cblinfun.diff_left cinner_diff_right)
{ fix f g α
have ‹0 = cinner (f + α *⇩C g) (C *⇩V (f + α *⇩C g))›
by (simp add: cinner_diff_right minus_cblinfun.rep_eq)
also have ‹… = α *⇩C cinner f (C g) + cnj α *⇩C cinner g (C f)›
by (smt (z3) C0 add.commute add.right_neutral cblinfun.add_right cblinfun.scaleC_right cblinfun_cinner_right.rep_eq cinner_add_left cinner_scaleC_left complex_scaleC_def)
finally have ‹α *⇩C cinner f (C g) = - cnj α *⇩C cinner g (C f)›
by (simp add: eq_neg_iff_add_eq_0)
}
then have ‹cinner f (C g) = 0› for f g
by (metis complex_cnj_i complex_cnj_one complex_vector.scale_cancel_right complex_vector.scale_left_imp_eq equation_minus_iff i_squared mult_eq_0_iff one_neq_neg_one)
then have ‹C g = 0› for g
using cinner_eq_zero_iff by blast
then have ‹C = 0›
by (simp add: cblinfun_eqI)
then show ‹A = B›
using C_def by auto
qed
lemma id_cblinfun_not_0[simp]: ‹(id_cblinfun :: 'a::{complex_normed_vector, not_singleton} ⇒⇩C⇩L _) ≠ 0›
by (metis (full_types) Extra_General.UNIV_not_singleton cblinfun.zero_left cblinfun_id_cblinfun_apply ex_norm1 norm_zero one_neq_zero)
lemma cblinfun_norm_geqI:
assumes ‹norm (f *⇩V x) / norm x ≥ K›
shows ‹norm f ≥ K›
using assms apply transfer
by (smt (z3) bounded_clinear.bounded_linear le_onorm)
declare scaleC_conv_of_complex[simp]
lemma cblinfun_eq_0_on_span:
fixes S::‹'a::complex_normed_vector set›
assumes "x ∈ cspan S"
and "⋀s. s∈S ⟹ F *⇩V s = 0"
shows ‹F *⇩V x = 0›
apply (rule complex_vector.linear_eq_0_on_span[where f=F])
using bounded_clinear.axioms(1) cblinfun_apply assms by auto
lemma cblinfun_eq_on_span:
fixes S::‹'a::complex_normed_vector set›
assumes "x ∈ cspan S"
and "⋀s. s∈S ⟹ F *⇩V s = G *⇩V s"
shows ‹F *⇩V x = G *⇩V x›
apply (rule complex_vector.linear_eq_on_span[where f=F])
using bounded_clinear.axioms(1) cblinfun_apply assms by auto
lemma cblinfun_eq_0_on_UNIV_span:
fixes basis::‹'a::complex_normed_vector set›
assumes "cspan basis = UNIV"
and "⋀s. s∈basis ⟹ F *⇩V s = 0"
shows ‹F = 0›
by (metis cblinfun_eq_0_on_span UNIV_I assms cblinfun.zero_left cblinfun_eqI)
lemma cblinfun_eq_on_UNIV_span:
fixes basis::"'a::complex_normed_vector set" and φ::"'a ⇒ 'b::complex_normed_vector"
assumes "cspan basis = UNIV"
and "⋀s. s∈basis ⟹ F *⇩V s = G *⇩V s"
shows ‹F = G›
proof-
have "F - G = 0"
apply (rule cblinfun_eq_0_on_UNIV_span[where basis=basis])
using assms by (auto simp add: cblinfun.diff_left)
thus ?thesis by simp
qed
lemma cblinfun_eq_on_canonical_basis:
fixes f g::"'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'b::complex_normed_vector"
defines "basis == set (canonical_basis::'a list)"
assumes "⋀u. u ∈ basis ⟹ f *⇩V u = g *⇩V u"
shows "f = g"
apply (rule cblinfun_eq_on_UNIV_span[where basis=basis])
using assms is_generator_set is_cindependent_set by auto
lemma cblinfun_eq_0_on_canonical_basis:
fixes f ::"'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'b::complex_normed_vector"
defines "basis == set (canonical_basis::'a list)"
assumes "⋀u. u ∈ basis ⟹ f *⇩V u = 0"
shows "f = 0"
by (simp add: assms cblinfun_eq_on_canonical_basis)
lemma cinner_canonical_basis_eq_0:
defines "basisA == set (canonical_basis::'a::onb_enum list)"
and "basisB == set (canonical_basis::'b::onb_enum list)"
assumes "⋀u v. u∈basisA ⟹ v∈basisB ⟹ ⟨v, F *⇩V u⟩ = 0"
shows "F = 0"
proof-
have "F *⇩V u = 0"
if "u∈basisA" for u
proof-
have "⋀v. v∈basisB ⟹ ⟨v, F *⇩V u⟩ = 0"
by (simp add: assms(3) that)
moreover have "(⋀v. v∈basisB ⟹ ⟨v, x⟩ = 0) ⟹ x = 0"
for x
proof-
assume r1: "⋀v. v∈basisB ⟹ ⟨v, x⟩ = 0"
have "⟨v, x⟩ = 0" for v
proof-
have "cspan basisB = UNIV"
using basisB_def is_generator_set by auto
hence "v ∈ cspan basisB"
by (smt iso_tuple_UNIV_I)
hence "∃t s. v = (∑a∈t. s a *⇩C a) ∧ finite t ∧ t ⊆ basisB"
using complex_vector.span_explicit
by (smt mem_Collect_eq)
then obtain t s where b1: "v = (∑a∈t. s a *⇩C a)" and b2: "finite t" and b3: "t ⊆ basisB"
by blast
have "⟨v, x⟩ = ⟨(∑a∈t. s a *⇩C a), x⟩"
by (simp add: b1)
also have "… = (∑a∈t. ⟨s a *⇩C a, x⟩)"
using cinner_sum_left by blast
also have "… = (∑a∈t. cnj (s a) * ⟨a, x⟩)"
by auto
also have "… = 0"
using b3 r1 subsetD by force
finally show ?thesis by simp
qed
thus ?thesis
by (simp add: ‹⋀v. ⟨v, x⟩ = 0› cinner_extensionality)
qed
ultimately show ?thesis by simp
qed
thus ?thesis
using basisA_def cblinfun_eq_0_on_canonical_basis by auto
qed
lemma cinner_canonical_basis_eq:
defines "basisA == set (canonical_basis::'a::onb_enum list)"
and "basisB == set (canonical_basis::'b::onb_enum list)"
assumes "⋀u v. u∈basisA ⟹ v∈basisB ⟹ ⟨v, F *⇩V u⟩ = ⟨v, G *⇩V u⟩"
shows "F = G"
proof-
define H where "H = F - G"
have "⋀u v. u∈basisA ⟹ v∈basisB ⟹ ⟨v, H *⇩V u⟩ = 0"
unfolding H_def
by (simp add: assms(3) cinner_diff_right minus_cblinfun.rep_eq)
hence "H = 0"
by (simp add: basisA_def basisB_def cinner_canonical_basis_eq_0)
thus ?thesis unfolding H_def by simp
qed
lemma cinner_canonical_basis_eq':
defines "basisA == set (canonical_basis::'a::onb_enum list)"
and "basisB == set (canonical_basis::'b::onb_enum list)"
assumes "⋀u v. u∈basisA ⟹ v∈basisB ⟹ ⟨F *⇩V u, v⟩ = ⟨G *⇩V u, v⟩"
shows "F = G"
using cinner_canonical_basis_eq assms
by (metis cinner_commute')
lemma cblinfun_norm_approx_witness:
fixes A :: ‹'a::{not_singleton,complex_normed_vector} ⇒⇩C⇩L 'b::complex_normed_vector›
assumes ‹ε > 0›
shows ‹∃ψ. norm (A *⇩V ψ) ≥ norm A - ε ∧ norm ψ = 1›
proof (transfer fixing: ε)
fix A :: ‹'a ⇒ 'b› assume [simp]: ‹bounded_clinear A›
have ‹∃y∈{norm (A x) |x. norm x = 1}. y > ⨆ {norm (A x) |x. norm x = 1} - ε›
apply (rule Sup_real_close)
using assms by (auto simp: ex_norm1 bounded_clinear.bounded_linear bdd_above_norm_f)
also have ‹⨆ {norm (A x) |x. norm x = 1} = onorm A›
by (simp add: Complex_Vector_Spaces0.bounded_clinear.bounded_linear onorm_sphere)
finally
show ‹∃ψ. onorm A - ε ≤ norm (A ψ) ∧ norm ψ = 1›
by force
qed
lemma cblinfun_norm_approx_witness_mult:
fixes A :: ‹'a::{not_singleton,complex_normed_vector} ⇒⇩C⇩L 'b::complex_normed_vector›
assumes ‹ε < 1›
shows ‹∃ψ. norm (A *⇩V ψ) ≥ norm A * ε ∧ norm ψ = 1›
proof (cases ‹norm A = 0›)
case True
then show ?thesis
apply auto
by (simp add: ex_norm1)
next
case False
then have ‹(1 - ε) * norm A > 0›
using assms by fastforce
then obtain ψ where geq: ‹norm (A *⇩V ψ) ≥ norm A - ((1 - ε) * norm A)› and ‹norm ψ = 1›
using cblinfun_norm_approx_witness by blast
have ‹norm A * ε = norm A - (1 - ε) * norm A›
by (simp add: mult.commute right_diff_distrib')
also have ‹… ≤ norm (A *⇩V ψ)›
by (rule geq)
finally show ?thesis
using ‹norm ψ = 1› by auto
qed
lemma cblinfun_to_CARD_1_0[simp]: ‹(A :: _ ⇒⇩C⇩L _::CARD_1) = 0›
apply (rule cblinfun_eqI)
by auto
lemma cblinfun_from_CARD_1_0[simp]: ‹(A :: _::CARD_1 ⇒⇩C⇩L _) = 0›
apply (rule cblinfun_eqI)
apply (subst CARD_1_vec_0)
by auto
lemma cblinfun_cspan_UNIV:
fixes basis :: ‹('a::{complex_normed_vector,cfinite_dim} ⇒⇩C⇩L 'b::complex_normed_vector) set›
and basisA :: ‹'a set› and basisB :: ‹'b set›
assumes ‹cspan basisA = UNIV› and ‹cspan basisB = UNIV›
assumes basis: ‹⋀a b. a∈basisA ⟹ b∈basisB ⟹ ∃F∈basis. ∀a'∈basisA. F *⇩V a' = (if a'=a then b else 0)›
shows ‹cspan basis = UNIV›
proof -
obtain basisA' where ‹basisA' ⊆ basisA› and ‹cindependent basisA'› and ‹cspan basisA' = UNIV›
by (metis assms(1) complex_vector.maximal_independent_subset complex_vector.span_eq top_greatest)
then have [simp]: ‹finite basisA'›
by (simp add: cindependent_cfinite_dim_finite)
have basis': ‹⋀a b. a∈basisA' ⟹ b∈basisB ⟹ ∃F∈basis. ∀a'∈basisA'. F *⇩V a' = (if a'=a then b else 0)›
using basis ‹basisA' ⊆ basisA› by fastforce
obtain F where F: ‹F a b ∈ basis ∧ F a b *⇩V a' = (if a'=a then b else 0)›
if ‹a∈basisA'› ‹b∈basisB› ‹a'∈basisA'› for a b a'
apply atomize_elim apply (intro choice allI)
using basis' by metis
then have F_apply: ‹F a b *⇩V a' = (if a'=a then b else 0)›
if ‹a∈basisA'› ‹b∈basisB› ‹a'∈basisA'› for a b a'
using that by auto
have F_basis: ‹F a b ∈ basis›
if ‹a∈basisA'› ‹b∈basisB› for a b
using that F by auto
have b_span: ‹∃G∈cspan {F a b|b. b∈basisB}. ∀a'∈basisA'. G *⇩V a' = (if a'=a then b else 0)› if ‹a∈basisA'› for a b
proof -
from ‹cspan basisB = UNIV›
obtain r t where ‹finite t› and ‹t ⊆ basisB› and b_lincom: ‹b = (∑a∈t. r a *⇩C a)›
unfolding complex_vector.span_alt apply atomize_elim by blast
define G where ‹G = (∑i∈t. r i *⇩C F a i)›
have ‹G ∈ cspan {F a b|b. b∈basisB}›
using ‹finite t› ‹t ⊆ basisB› unfolding G_def
by (smt (verit, ccfv_threshold) complex_vector.span_base complex_vector.span_scale complex_vector.span_sum mem_Collect_eq subset_eq)
moreover have ‹G *⇩V a' = (if a'=a then b else 0)› if ‹a'∈basisA'› for a'
apply (cases ‹a'=a›)
using ‹t ⊆ basisB› ‹a∈basisA'› ‹a'∈basisA'›
by (auto simp: b_lincom G_def cblinfun.sum_left F_apply intro!: sum.neutral sum.cong)
ultimately show ?thesis
by blast
qed
have a_span: ‹cspan (⋃a∈basisA'. cspan {F a b|b. b∈basisB}) = UNIV›
proof (intro equalityI subset_UNIV subsetI, rename_tac H)
fix H
obtain G where G: ‹G a b ∈ cspan {F a b|b. b∈basisB} ∧ G a b *⇩V a' = (if a'=a then b else 0)› if ‹a∈basisA'› and ‹a'∈basisA'› for a b a'
apply atomize_elim apply (intro choice allI)
using b_span by blast
then have G_cspan: ‹G a b ∈ cspan {F a b|b. b∈basisB}› if ‹a∈basisA'› for a b
using that by auto
from G have G: ‹G a b *⇩V a' = (if a'=a then b else 0)› if ‹a∈basisA'› and ‹a'∈basisA'› for a b a'
using that by auto
define H' where ‹H' = (∑a∈basisA'. G a (H *⇩V a))›
have ‹H' ∈ cspan (⋃a∈basisA'. cspan {F a b|b. b∈basisB})›
unfolding H'_def using G_cspan
by (smt (verit, del_insts) UN_iff complex_vector.span_clauses(1) complex_vector.span_sum)
moreover have ‹H' = H›
using ‹cspan basisA' = UNIV› apply (rule cblinfun_eq_on_UNIV_span)
apply (auto simp: H'_def cblinfun.sum_left)
apply (subst sum_single)
by (auto simp: G)
ultimately show ‹H ∈ cspan (⋃a∈basisA'. cspan {F a b |b. b ∈ basisB})›
by simp
qed
moreover have ‹cspan basis ⊇ cspan (⋃a∈basisA'. cspan {F a b|b. b∈basisB})›
using F_basis
by (smt (z3) UN_subset_iff complex_vector.span_alt complex_vector.span_minimal complex_vector.subspace_span mem_Collect_eq subset_iff)
ultimately show ‹cspan basis = UNIV›
by auto
qed
instance cblinfun :: (‹{cfinite_dim,complex_normed_vector}›, ‹{cfinite_dim,complex_normed_vector}›) cfinite_dim
proof intro_classes
obtain basisA :: ‹'a set› where [simp]: ‹cspan basisA = UNIV› ‹cindependent basisA› ‹finite basisA›
using finite_basis by blast
obtain basisB :: ‹'b set› where [simp]: ‹cspan basisB = UNIV› ‹cindependent basisB› ‹finite basisB›
using finite_basis by blast
define f where ‹f a b = cconstruct basisA (λx. if x=a then b else 0)› for a :: 'a and b :: 'b
have f_a: ‹f a b a = b› if ‹a : basisA› for a b
by (simp add: complex_vector.construct_basis f_def that)
have f_not_a: ‹f a b c = 0› if ‹a : basisA› and ‹c : basisA› and ‹a ≠ c›for a b c
using that by (simp add: complex_vector.construct_basis f_def)
define F where ‹F a b = CBlinfun (f a b)› for a b
have ‹clinear (f a b)› for a b
by (auto intro: complex_vector.linear_construct simp: f_def)
then have ‹bounded_clinear (f a b)› for a b
by auto
then have F_apply: ‹cblinfun_apply (F a b) = f a b› for a b
by (simp add: F_def bounded_clinear_CBlinfun_apply)
define basis where ‹basis = {F a b| a b. a∈basisA ∧ b∈basisB}›
have ‹cspan basis = UNIV›
apply (rule cblinfun_cspan_UNIV[where basisA=basisA and basisB=basisB])
apply (auto simp: basis_def)
by (metis F_apply f_a f_not_a)
moreover have ‹finite basis›
unfolding basis_def apply (rule finite_image_set2) by auto
ultimately show ‹∃S :: ('a ⇒⇩C⇩L 'b) set. finite S ∧ cspan S = UNIV›
by auto
qed
subsection ‹Relationship to real bounded operators (\<^typ>‹_ ⇒⇩L _›)›
instantiation blinfun :: (real_normed_vector, complex_normed_vector) "complex_normed_vector"
begin
lift_definition scaleC_blinfun :: ‹complex ⇒
('a::real_normed_vector, 'b::complex_normed_vector) blinfun ⇒
('a, 'b) blinfun›
is ‹λ c::complex. λ f::'a⇒'b. (λ x. c *⇩C (f x) )›
proof
fix c::complex and f :: ‹'a⇒'b› and b1::'a and b2::'a
assume ‹bounded_linear f›
show ‹c *⇩C f (b1 + b2) = c *⇩C f b1 + c *⇩C f b2›
by (simp add: ‹bounded_linear f› linear_simps scaleC_add_right)
fix c::complex and f :: ‹'a⇒'b› and b::'a and r::real
assume ‹bounded_linear f›
show ‹c *⇩C f (r *⇩R b) = r *⇩R (c *⇩C f b)›
by (simp add: ‹bounded_linear f› linear_simps(5) scaleR_scaleC)
fix c::complex and f :: ‹'a⇒'b›
assume ‹bounded_linear f›
have ‹∃ K. ∀ x. norm (f x) ≤ norm x * K›
using ‹bounded_linear f›
by (simp add: bounded_linear.bounded)
then obtain K where ‹∀ x. norm (f x) ≤ norm x * K›
by blast
have ‹cmod c ≥ 0›
by simp
hence ‹∀ x. (cmod c) * norm (f x) ≤ (cmod c) * norm x * K›
using ‹∀ x. norm (f x) ≤ norm x * K›
by (metis ordered_comm_semiring_class.comm_mult_left_mono vector_space_over_itself.scale_scale)
moreover have ‹norm (c *⇩C f x) = (cmod c) * norm (f x)›
for x
by simp
ultimately show ‹∃K. ∀x. norm (c *⇩C f x) ≤ norm x * K›
by (metis ab_semigroup_mult_class.mult_ac(1) mult.commute)
qed
instance
proof
have "r *⇩R x = complex_of_real r *⇩C x"
for x :: "('a, 'b) blinfun" and r
apply transfer
by (simp add: scaleR_scaleC)
thus "((*⇩R) r::'a ⇒⇩L 'b ⇒ _) = (*⇩C) (complex_of_real r)" for r
by auto
show "a *⇩C (x + y) = a *⇩C x + a *⇩C y"
for a :: complex and x y :: "'a ⇒⇩L 'b"
apply transfer
by (simp add: scaleC_add_right)
show "(a + b) *⇩C x = a *⇩C x + b *⇩C x"
for a b :: complex and x :: "'a ⇒⇩L 'b"
apply transfer
by (simp add: scaleC_add_left)
show "a *⇩C b *⇩C x = (a * b) *⇩C x"
for a b :: complex and x :: "'a ⇒⇩L 'b"
apply transfer
by simp
have ‹1 *⇩C f x = f x›
for f :: ‹'a⇒'b› and x
by auto
thus "1 *⇩C x = x"
for x :: "'a ⇒⇩L 'b"
by (simp add: scaleC_blinfun.rep_eq blinfun_eqI)
have ‹onorm (λx. a *⇩C f x) = cmod a * onorm f›
if ‹bounded_linear f›
for f :: ‹'a ⇒ 'b› and a :: complex
proof-
have ‹cmod a ≥ 0›
by simp
have ‹∃ K::real. ∀ x. (¦ ereal ((norm (f x)) / (norm x)) ¦) ≤ K›
using ‹bounded_linear f› le_onorm by fastforce
then obtain K::real where ‹∀ x. (¦ ereal ((norm (f x)) / (norm x)) ¦) ≤ K›
by blast
hence ‹∀ x. (cmod a) *(¦ ereal ((norm (f x)) / (norm x)) ¦) ≤ (cmod a) * K›
using ‹cmod a ≥ 0›
by (metis abs_ereal.simps(1) abs_ereal_pos abs_pos ereal_mult_left_mono times_ereal.simps(1))
hence ‹∀ x. (¦ ereal ((cmod a) * (norm (f x)) / (norm x)) ¦) ≤ (cmod a) * K›
by simp
hence ‹bdd_above {ereal (cmod a * (norm (f x)) / (norm x)) | x. True}›
by simp
moreover have ‹{ereal (cmod a * (norm (f x)) / (norm x)) | x. True} ≠ {}›
by auto
ultimately have p1: ‹(SUP x. ¦ereal (cmod a * (norm (f x)) / (norm x))¦) ≤ cmod a * K›
using ‹∀ x. ¦ ereal (cmod a * (norm (f x)) / (norm x)) ¦ ≤ cmod a * K›
Sup_least mem_Collect_eq
by (simp add: SUP_le_iff)
have p2: ‹⋀i. i ∈ UNIV ⟹ 0 ≤ ereal (cmod a * norm (f i) / norm i)›
by simp
hence ‹¦SUP x. ereal (cmod a * (norm (f x)) / (norm x))¦
≤ (SUP x. ¦ereal (cmod a * (norm (f x)) / (norm x))¦)›
using ‹bdd_above {ereal (cmod a * (norm (f x)) / (norm x)) | x. True}›
‹{ereal (cmod a * (norm (f x)) / (norm x)) | x. True} ≠ {}›
by (metis (mono_tags, lifting) SUP_upper2 Sup.SUP_cong UNIV_I
p2 abs_ereal_ge0 ereal_le_real)
hence ‹¦SUP x. ereal (cmod a * (norm (f x)) / (norm x))¦ ≤ cmod a * K›
using ‹(SUP x. ¦ereal (cmod a * (norm (f x)) / (norm x))¦) ≤ cmod a * K›
by simp
hence ‹¦ ( SUP i∈UNIV::'a set. ereal ((λ x. (cmod a) * (norm (f x)) / norm x) i)) ¦ ≠ ∞›
by auto
hence w2: ‹( SUP i∈UNIV::'a set. ereal ((λ x. cmod a * (norm (f x)) / norm x) i))
= ereal ( Sup ((λ x. cmod a * (norm (f x)) / norm x) ` (UNIV::'a set) ))›
by (simp add: ereal_SUP)
have ‹(UNIV::('a set)) ≠ {}›
by simp
moreover have ‹⋀ i. i ∈ (UNIV::('a set)) ⟹ (λ x. (norm (f x)) / norm x :: ereal) i ≥ 0›
by simp
moreover have ‹cmod a ≥ 0›
by simp
ultimately have ‹(SUP i∈(UNIV::('a set)). ((cmod a)::ereal) * (λ x. (norm (f x)) / norm x :: ereal) i )
= ((cmod a)::ereal) * ( SUP i∈(UNIV::('a set)). (λ x. (norm (f x)) / norm x :: ereal) i )›
by (simp add: Sup_ereal_mult_left')
hence ‹(SUP x. ((cmod a)::ereal) * ( (norm (f x)) / norm x :: ereal) )
= ((cmod a)::ereal) * ( SUP x. ( (norm (f x)) / norm x :: ereal) )›
by simp
hence z1: ‹real_of_ereal ( (SUP x. ((cmod a)::ereal) * ( (norm (f x)) / norm x :: ereal) ) )
= real_of_ereal ( ((cmod a)::ereal) * ( SUP x. ( (norm (f x)) / norm x :: ereal) ) )›
by simp
have z2: ‹real_of_ereal (SUP x. ((cmod a)::ereal) * ( (norm (f x)) / norm x :: ereal) )
= (SUP x. cmod a * (norm (f x) / norm x))›
using w2
by auto
have ‹real_of_ereal ( ((cmod a)::ereal) * ( SUP x. ( (norm (f x)) / norm x :: ereal) ) )
= (cmod a) * real_of_ereal ( SUP x. ( (norm (f x)) / norm x :: ereal) )›
by simp
moreover have ‹real_of_ereal ( SUP x. ( (norm (f x)) / norm x :: ereal) )
= ( SUP x. ((norm (f x)) / norm x) )›
proof-
have ‹¦ ( SUP i∈UNIV::'a set. ereal ((λ x. (norm (f x)) / norm x) i)) ¦ ≠ ∞›
proof-
have ‹∃ K::real. ∀ x. (¦ ereal ((norm (f x)) / (norm x)) ¦) ≤ K›
using ‹bounded_linear f› le_onorm by fastforce
then obtain K::real where ‹∀ x. (¦ ereal ((norm (f x)) / (norm x)) ¦) ≤ K›
by blast
hence ‹bdd_above {ereal ((norm (f x)) / (norm x)) | x. True}›
by simp
moreover have ‹{ereal ((norm (f x)) / (norm x)) | x. True} ≠ {}›
by auto
ultimately have ‹(SUP x. ¦ereal ((norm (f x)) / (norm x))¦) ≤ K›
using ‹∀ x. ¦ ereal ((norm (f x)) / (norm x)) ¦ ≤ K›
Sup_least mem_Collect_eq
by (simp add: SUP_le_iff)
hence ‹¦SUP x. ereal ((norm (f x)) / (norm x))¦
≤ (SUP x. ¦ereal ((norm (f x)) / (norm x))¦)›
using ‹bdd_above {ereal ((norm (f x)) / (norm x)) | x. True}›
‹{ereal ((norm (f x)) / (norm x)) | x. True} ≠ {}›
by (metis (mono_tags, lifting) SUP_upper2 Sup.SUP_cong UNIV_I ‹⋀i. i ∈ UNIV ⟹ 0 ≤ ereal (norm (f i) / norm i)› abs_ereal_ge0 ereal_le_real)
hence ‹¦SUP x. ereal ((norm (f x)) / (norm x))¦ ≤ K›
using ‹(SUP x. ¦ereal ((norm (f x)) / (norm x))¦) ≤ K›
by simp
thus ?thesis
by auto
qed
hence ‹ ( SUP i∈UNIV::'a set. ereal ((λ x. (norm (f x)) / norm x) i))
= ereal ( Sup ((λ x. (norm (f x)) / norm x) ` (UNIV::'a set) ))›
by (simp add: ereal_SUP)
thus ?thesis
by simp
qed
have z3: ‹real_of_ereal ( ((cmod a)::ereal) * ( SUP x. ( (norm (f x)) / norm x :: ereal) ) )
= cmod a * (SUP x. norm (f x) / norm x)›
by (simp add: ‹real_of_ereal (SUP x. ereal (norm (f x) / norm x)) = (SUP x. norm (f x) / norm x)›)
hence w1: ‹(SUP x. cmod a * (norm (f x) / norm x)) =
cmod a * (SUP x. norm (f x) / norm x)›
using z1 z2 by linarith
have v1: ‹onorm (λx. a *⇩C f x) = (SUP x. norm (a *⇩C f x) / norm x)›
by (simp add: onorm_def)
have v2: ‹(SUP x. norm (a *⇩C f x) / norm x) = (SUP x. ((cmod a) * norm (f x)) / norm x)›
by simp
have v3: ‹(SUP x. ((cmod a) * norm (f x)) / norm x) = (SUP x. (cmod a) * ((norm (f x)) / norm x))›
by simp
have v4: ‹(SUP x. (cmod a) * ((norm (f x)) / norm x)) = (cmod a) * (SUP x. ((norm (f x)) / norm x))›
using w1
by blast
show ‹onorm (λx. a *⇩C f x) = cmod a * onorm f›
using v1 v2 v3 v4
by (metis (mono_tags, lifting) onorm_def)
qed
thus ‹norm (a *⇩C x) = cmod a * norm x›
for a::complex and x::‹('a, 'b) blinfun›
apply transfer
by blast
qed
end
lemma clinear_blinfun_compose_left: ‹clinear (λx. blinfun_compose x y)›
by (auto intro!: clinearI simp: blinfun_eqI scaleC_blinfun.rep_eq bounded_bilinear.add_left
bounded_bilinear_blinfun_compose)
instantiation blinfun :: (real_normed_vector, cbanach) "cbanach"
begin
instance..
end
lemma blinfun_compose_assoc: "(A o⇩L B) o⇩L C = A o⇩L (B o⇩L C)"
by (simp add: blinfun_eqI)
lift_definition blinfun_of_cblinfun::‹'a::complex_normed_vector ⇒⇩C⇩L 'b::complex_normed_vector
⇒ 'a ⇒⇩L 'b› is "id"
apply transfer by (simp add: bounded_clinear.bounded_linear)
lift_definition blinfun_cblinfun_eq ::
‹'a ⇒⇩L 'b ⇒ 'a::complex_normed_vector ⇒⇩C⇩L 'b::complex_normed_vector ⇒ bool› is "(=)" .
lemma blinfun_cblinfun_eq_bi_unique[transfer_rule]: ‹bi_unique blinfun_cblinfun_eq›
unfolding bi_unique_def apply transfer by auto
lemma blinfun_cblinfun_eq_right_total[transfer_rule]: ‹right_total blinfun_cblinfun_eq›
unfolding right_total_def apply transfer
by (simp add: bounded_clinear.bounded_linear)
named_theorems cblinfun_blinfun_transfer
lemma cblinfun_blinfun_transfer_0[cblinfun_blinfun_transfer]:
"blinfun_cblinfun_eq (0::(_,_) blinfun) (0::(_,_) cblinfun)"
apply transfer by simp
lemma cblinfun_blinfun_transfer_plus[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (+) (+)"
unfolding rel_fun_def apply transfer by auto
lemma cblinfun_blinfun_transfer_minus[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (-) (-)"
unfolding rel_fun_def apply transfer by auto
lemma cblinfun_blinfun_transfer_uminus[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (uminus) (uminus)"
unfolding rel_fun_def apply transfer by auto
definition "real_complex_eq r c ⟷ complex_of_real r = c"
lemma bi_unique_real_complex_eq[transfer_rule]: ‹bi_unique real_complex_eq›
unfolding real_complex_eq_def bi_unique_def by auto
lemma left_total_real_complex_eq[transfer_rule]: ‹left_total real_complex_eq›
unfolding real_complex_eq_def left_total_def by auto
lemma cblinfun_blinfun_transfer_scaleC[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(real_complex_eq ===> blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (scaleR) (scaleC)"
unfolding rel_fun_def apply transfer
by (simp add: real_complex_eq_def scaleR_scaleC)
lemma cblinfun_blinfun_transfer_CBlinfun[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(eq_onp bounded_clinear ===> blinfun_cblinfun_eq) Blinfun CBlinfun"
unfolding rel_fun_def blinfun_cblinfun_eq.rep_eq eq_onp_def
by (auto simp: CBlinfun_inverse Blinfun_inverse bounded_clinear.bounded_linear)
lemma cblinfun_blinfun_transfer_norm[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(blinfun_cblinfun_eq ===> (=)) norm norm"
unfolding rel_fun_def apply transfer by auto
lemma cblinfun_blinfun_transfer_dist[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq ===> (=)) dist dist"
unfolding rel_fun_def dist_norm apply transfer by auto
lemma cblinfun_blinfun_transfer_sgn[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) sgn sgn"
unfolding rel_fun_def sgn_blinfun_def sgn_cblinfun_def apply transfer
by (auto simp: scaleR_scaleC)
lemma cblinfun_blinfun_transfer_Cauchy[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(((=) ===> blinfun_cblinfun_eq) ===> (=)) Cauchy Cauchy"
proof -
note cblinfun_blinfun_transfer[transfer_rule]
show ?thesis
unfolding Cauchy_def
by transfer_prover
qed
lemma cblinfun_blinfun_transfer_tendsto[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(((=) ===> blinfun_cblinfun_eq) ===> blinfun_cblinfun_eq ===> (=) ===> (=)) tendsto tendsto"
proof -
note cblinfun_blinfun_transfer[transfer_rule]
show ?thesis
unfolding tendsto_iff
by transfer_prover
qed
lemma cblinfun_blinfun_transfer_compose[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(blinfun_cblinfun_eq ===> blinfun_cblinfun_eq ===> blinfun_cblinfun_eq) (o⇩L) (o⇩C⇩L)"
unfolding rel_fun_def apply transfer by auto
lemma cblinfun_blinfun_transfer_apply[cblinfun_blinfun_transfer]:
includes lifting_syntax
shows "(blinfun_cblinfun_eq ===> (=) ===> (=)) blinfun_apply cblinfun_apply"
unfolding rel_fun_def apply transfer by auto
lemma blinfun_of_cblinfun_inj:
‹blinfun_of_cblinfun f = blinfun_of_cblinfun g ⟹ f = g›
by (metis cblinfun_apply_inject blinfun_of_cblinfun.rep_eq)
lemma blinfun_of_cblinfun_inv:
assumes "⋀c. ⋀x. f *⇩v (c *⇩C x) = c *⇩C (f *⇩v x)"
shows "∃g. blinfun_of_cblinfun g = f"
using assms
proof transfer
show "∃g∈Collect bounded_clinear. id g = f"
if "bounded_linear f"
and "⋀c x. f (c *⇩C x) = c *⇩C f x"
for f :: "'a ⇒ 'b"
using that bounded_linear_bounded_clinear by auto
qed
lemma blinfun_of_cblinfun_zero:
‹blinfun_of_cblinfun 0 = 0›
apply transfer by simp
lemma blinfun_of_cblinfun_uminus:
‹blinfun_of_cblinfun (- f) = - (blinfun_of_cblinfun f)›
apply transfer
by auto
lemma blinfun_of_cblinfun_minus:
‹blinfun_of_cblinfun (f - g) = blinfun_of_cblinfun f - blinfun_of_cblinfun g›
apply transfer
by auto
lemma blinfun_of_cblinfun_scaleC:
‹blinfun_of_cblinfun (c *⇩C f) = c *⇩C (blinfun_of_cblinfun f)›
apply transfer
by auto
lemma blinfun_of_cblinfun_scaleR:
‹blinfun_of_cblinfun (c *⇩R f) = c *⇩R (blinfun_of_cblinfun f)›
apply transfer by auto
lemma blinfun_of_cblinfun_norm:
fixes f::‹'a::complex_normed_vector ⇒⇩C⇩L 'b::complex_normed_vector›
shows ‹norm f = norm (blinfun_of_cblinfun f)›
apply transfer by auto
subsection ‹Composition›
lemma blinfun_of_cblinfun_cblinfun_compose:
fixes f::‹'b::complex_normed_vector ⇒⇩C⇩L 'c::complex_normed_vector›
and g::‹'a::complex_normed_vector ⇒⇩C⇩L 'b›
shows ‹blinfun_of_cblinfun (f o⇩C⇩L g) = (blinfun_of_cblinfun f) o⇩L (blinfun_of_cblinfun g)›
apply transfer by auto
lemma cblinfun_compose_assoc:
shows "(A o⇩C⇩L B) o⇩C⇩L C = A o⇩C⇩L (B o⇩C⇩L C)"
by (metis (no_types, lifting) cblinfun_apply_inject fun.map_comp cblinfun_compose.rep_eq)
lemma cblinfun_compose_zero_right[simp]: "U o⇩C⇩L 0 = 0"
using bounded_cbilinear.zero_right bounded_cbilinear_cblinfun_compose by blast
lemma cblinfun_compose_zero_left[simp]: "0 o⇩C⇩L U = 0"
using bounded_cbilinear.zero_left bounded_cbilinear_cblinfun_compose by blast
lemma cblinfun_compose_scaleC_left[simp]:
fixes A::"'b::complex_normed_vector ⇒⇩C⇩L 'c::complex_normed_vector"
and B::"'a::complex_normed_vector ⇒⇩C⇩L 'b"
shows ‹(a *⇩C A) o⇩C⇩L B = a *⇩C (A o⇩C⇩L B)›
by (simp add: bounded_cbilinear.scaleC_left bounded_cbilinear_cblinfun_compose)
lemma cblinfun_compose_scaleR_left[simp]:
fixes A::"'b::complex_normed_vector ⇒⇩C⇩L 'c::complex_normed_vector"
and B::"'a::complex_normed_vector ⇒⇩C⇩L 'b"
shows ‹(a *⇩R A) o⇩C⇩L B = a *⇩R (A o⇩C⇩L B)›
by (simp add: scaleR_scaleC)
lemma cblinfun_compose_scaleC_right[simp]:
fixes A::"'b::complex_normed_vector ⇒⇩C⇩L 'c::complex_normed_vector"
and B::"'a::complex_normed_vector ⇒⇩C⇩L 'b"
shows ‹A o⇩C⇩L (a *⇩C B) = a *⇩C (A o⇩C⇩L B)›
apply transfer by (auto intro!: ext bounded_clinear.clinear complex_vector.linear_scale)
lemma cblinfun_compose_scaleR_right[simp]:
fixes A::"'b::complex_normed_vector ⇒⇩C⇩L 'c::complex_normed_vector"
and B::"'a::complex_normed_vector ⇒⇩C⇩L 'b"
shows ‹A o⇩C⇩L (a *⇩R B) = a *⇩R (A o⇩C⇩L B)›
by (simp add: scaleR_scaleC)
lemma cblinfun_compose_id_right[simp]:
shows "U o⇩C⇩L id_cblinfun = U"
apply transfer by auto
lemma cblinfun_compose_id_left[simp]:
shows "id_cblinfun o⇩C⇩L U = U"
apply transfer by auto
lemma cblinfun_eq_on:
fixes A B :: "'a::cbanach ⇒⇩C⇩L'b::complex_normed_vector"
assumes "⋀x. x ∈ G ⟹ A *⇩V x = B *⇩V x" and ‹t ∈ closure (cspan G)›
shows "A *⇩V t = B *⇩V t"
using assms
apply transfer
using bounded_clinear_eq_on by blast
lemma cblinfun_eq_gen_eqI:
fixes A B :: "'a::cbanach ⇒⇩C⇩L'b::complex_normed_vector"
assumes "⋀x. x ∈ G ⟹ A *⇩V x = B *⇩V x" and ‹ccspan G = ⊤›
shows "A = B"
apply (rule cblinfun_eqI)
apply (rule cblinfun_eq_on[where G=G])
using assms apply auto
by (metis ccspan.rep_eq iso_tuple_UNIV_I top_ccsubspace.rep_eq)
lemma cblinfun_compose_add_left: ‹(a + b) o⇩C⇩L c = (a o⇩C⇩L c) + (b o⇩C⇩L c)›
by (simp add: bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose)
lemma cblinfun_compose_add_right: ‹a o⇩C⇩L (b + c) = (a o⇩C⇩L b) + (a o⇩C⇩L c)›
by (simp add: bounded_cbilinear.add_right bounded_cbilinear_cblinfun_compose)
lemma cbilinear_cblinfun_compose[simp]: "cbilinear cblinfun_compose"
by (auto intro!: clinearI simp add: cbilinear_def bounded_cbilinear.add_left bounded_cbilinear.add_right bounded_cbilinear_cblinfun_compose)
subsection ‹Adjoint›
lift_definition
adj :: "'a::chilbert_space ⇒⇩C⇩L 'b::complex_inner ⇒ 'b ⇒⇩C⇩L 'a" ("_*" [99] 100)
is cadjoint by (fact cadjoint_bounded_clinear)
lemma id_cblinfun_adjoint[simp]: "id_cblinfun* = id_cblinfun"
apply transfer using cadjoint_id
by (metis eq_id_iff)
lemma double_adj[simp]: "(A*)* = A"
apply transfer using double_cadjoint by blast
lemma adj_cblinfun_compose[simp]:
fixes B::‹'a::chilbert_space ⇒⇩C⇩L 'b::chilbert_space›
and A::‹'b ⇒⇩C⇩L 'c::complex_inner›
shows "(A o⇩C⇩L B)* = (B*) o⇩C⇩L (A*)"
proof transfer
fix A :: ‹'b ⇒ 'c› and B :: ‹'a ⇒ 'b›
assume ‹bounded_clinear A› and ‹bounded_clinear B›
hence ‹bounded_clinear (A ∘ B)›
by (simp add: comp_bounded_clinear)
have ‹⟨ (A ∘ B) u, v ⟩ = ⟨ u, (B⇧† ∘ A⇧†) v ⟩›
for u v
by (metis (no_types, lifting) cadjoint_univ_prop ‹bounded_clinear A› ‹bounded_clinear B› cinner_commute' comp_def)
thus ‹(A ∘ B)⇧† = B⇧† ∘ A⇧†›
using ‹bounded_clinear (A ∘ B)›
by (metis cadjoint_eqI cinner_commute')
qed
lemma scaleC_adj[simp]: "(a *⇩C A)* = (cnj a) *⇩C (A*)"
apply transfer
by (simp add: Complex_Vector_Spaces0.bounded_clinear.bounded_linear bounded_clinear_def complex_vector.linear_scale scaleC_cadjoint)
lemma scaleR_adj[simp]: "(a *⇩R A)* = a *⇩R (A*)"
by (simp add: scaleR_scaleC)
lemma adj_plus: ‹(A + B)* = (A*) + (B*)›
proof transfer
fix A B::‹'b ⇒ 'a›
assume a1: ‹bounded_clinear A› and a2: ‹bounded_clinear B›
define F where ‹F = (λx. (A⇧†) x + (B⇧†) x)›
define G where ‹G = (λx. A x + B x)›
have ‹bounded_clinear G›
unfolding G_def
by (simp add: a1 a2 bounded_clinear_add)
moreover have ‹⟨F u, v⟩ = ⟨u, G v⟩› for u v
unfolding F_def G_def
using cadjoint_univ_prop a1 a2 cinner_add_left
by (simp add: cadjoint_univ_prop cinner_add_left cinner_add_right)
ultimately have ‹F = G⇧† ›
using cadjoint_eqI by blast
thus ‹(λx. A x + B x)⇧† = (λx. (A⇧†) x + (B⇧†) x)›
unfolding F_def G_def
by auto
qed
lemma cinner_sup_norm_cblinfun:
fixes A :: ‹'a::{complex_normed_vector,not_singleton} ⇒⇩C⇩L 'b::complex_inner›
shows ‹norm A = (SUP (ψ,φ). cmod (cinner ψ (A *⇩V φ)) / (norm ψ * norm φ))›
apply transfer
apply (rule cinner_sup_onorm)
by (simp add: bounded_clinear.bounded_linear)
lemma cinner_adj_left:
fixes G :: "'b::chilbert_space ⇒⇩C⇩L 'a::complex_inner"
shows ‹⟨G* *⇩V x, y⟩ = ⟨x, G *⇩V y⟩›
apply transfer using cadjoint_univ_prop by blast
lemma cinner_adj_right:
fixes G :: "'b::chilbert_space ⇒⇩C⇩L 'a::complex_inner"
shows ‹⟨x, G* *⇩V y⟩ = ⟨G *⇩V x, y⟩›
apply transfer using cadjoint_univ_prop' by blast
lemma adj_0[simp]: ‹0* = 0›
by (metis add_cancel_right_left adj_plus)
lemma norm_adj[simp]: ‹norm (A*) = norm A›
for A :: ‹'b::chilbert_space ⇒⇩C⇩L 'c::complex_inner›
proof (cases ‹(∃x y :: 'b. x ≠ y) ∧ (∃x y :: 'c. x ≠ y)›)
case True
then have c1: ‹class.not_singleton TYPE('b)›
apply intro_classes by simp
from True have c2: ‹class.not_singleton TYPE('c)›
apply intro_classes by simp
have normA: ‹norm A = (SUP (ψ, φ). cmod (ψ ∙⇩C (A *⇩V φ)) / (norm ψ * norm φ))›
apply (rule cinner_sup_norm_cblinfun[internalize_sort ‹'a::{complex_normed_vector,not_singleton}›])
apply (rule complex_normed_vector_axioms)
by (rule c1)
have normAadj: ‹norm (A*) = (SUP (ψ, φ). cmod (ψ ∙⇩C (A* *⇩V φ)) / (norm ψ * norm φ))›
apply (rule cinner_sup_norm_cblinfun[internalize_sort ‹'a::{complex_normed_vector,not_singleton}›])
apply (rule complex_normed_vector_axioms)
by (rule c2)
have ‹norm (A*) = (SUP (ψ, φ). cmod (φ ∙⇩C (A *⇩V ψ)) / (norm ψ * norm φ))›
unfolding normAadj
apply (subst cinner_adj_right)
apply (subst cinner_commute)
apply (subst complex_mod_cnj)
by rule
also have ‹… = Sup ((λ(ψ, φ). cmod (φ ∙⇩C (A *⇩V ψ)) / (norm ψ * norm φ)) ` prod.swap ` UNIV)›
by auto
also have ‹… = (SUP (φ, ψ). cmod (φ ∙⇩C (A *⇩V ψ)) / (norm ψ * norm φ))›
apply (subst image_image)
by auto
also have ‹… = norm A›
unfolding normA
by (simp add: mult.commute)
finally show ?thesis
by -
next
case False
then consider (b) ‹⋀x::'b. x = 0› | (c) ‹⋀x::'c. x = 0›
by auto
then have ‹A = 0›
apply (cases; transfer)
apply (metis (full_types) bounded_clinear_def complex_vector.linear_0)
by auto
then show ‹norm (A*) = norm A›
by simp
qed
lemma antilinear_adj[simp]: ‹antilinear adj›
apply (rule antilinearI) by (auto simp add: adj_plus)
lemma bounded_antilinear_adj[bounded_antilinear, simp]: ‹bounded_antilinear adj›
by (auto intro!: antilinearI exI[of _ 1] simp: bounded_antilinear_def bounded_antilinear_axioms_def adj_plus)
lemma adjoint_eqI:
fixes G:: ‹'b::chilbert_space ⇒⇩C⇩L 'a::chilbert_space›
and F:: ‹'a ⇒⇩C⇩L 'b›
assumes ‹⋀x y. ⟨(cblinfun_apply F) x, y⟩ = ⟨x, (cblinfun_apply G) y⟩›
shows ‹F = G*›
using assms apply transfer using cadjoint_eqI by auto
lemma cinner_real_hermiteanI:
assumes ‹⋀ψ. cinner ψ (A *⇩V ψ) ∈ ℝ›
shows ‹A = A*›
proof -
{ fix g h :: 'a
{
fix α :: complex
have ‹cinner h (A h) + cnj α *⇩C cinner g (A h) + α *⇩C cinner h (A g) + (abs α)⇧2 * cinner g (A g)
= cinner (h + α *⇩C g) (A *⇩V (h + α *⇩C g))› (is ‹?sum4 = _›)
apply (auto simp: cinner_add_right cinner_add_left cblinfun.add_right cblinfun.scaleC_right ring_class.ring_distribs)
by (metis cnj_x_x mult.commute)
also have ‹… ∈ ℝ›
using assms by auto
finally have ‹?sum4 = cnj ?sum4›
using Reals_cnj_iff by fastforce
then have ‹cnj α *⇩C cinner g (A h) + α *⇩C cinner h (A g)
= α *⇩C cinner (A h) g + cnj α *⇩C cinner (A g) h›
using Reals_cnj_iff abs_complex_real assms by force
also have ‹… = α *⇩C cinner h (A* *⇩V g) + cnj α *⇩C cinner g (A* *⇩V h)›
by (simp add: cinner_adj_right)
finally have ‹cnj α *⇩C cinner g (A h) + α *⇩C cinner h (A g) = α *⇩C cinner h (A* *⇩V g) + cnj α *⇩C cinner g (A* *⇩V h)›
by -
}
from this[where α2=1] this[where α2=𝗂]
have 1: ‹cinner g (A h) + cinner h (A g) = cinner h (A* *⇩V g) + cinner g (A* *⇩V h)›
and i: ‹- 𝗂 * cinner g (A h) + 𝗂 *⇩C cinner h (A g) = 𝗂 *⇩C cinner h (A* *⇩V g) - 𝗂 *⇩C cinner g (A* *⇩V h)›
by auto
from arg_cong2[OF 1 arg_cong[OF i, where f=‹(*) (-𝗂)›], where f=plus]
have ‹cinner h (A g) = cinner h (A* *⇩V g)›
by (auto simp: ring_class.ring_distribs)
}
then show "A = A*"
by (simp add: adjoint_eqI cinner_adj_right)
qed
lemma norm_AAadj[simp]: ‹norm (A o⇩C⇩L A*) = (norm A)⇧2› for A :: ‹'a::chilbert_space ⇒⇩C⇩L 'b::{complex_inner}›
proof (cases ‹class.not_singleton TYPE('b)›)
case True
then have [simp]: ‹class.not_singleton TYPE('b)›
by -
have 1: ‹(norm A)⇧2 * ε ≤ norm (A o⇩C⇩L A*)› if ‹ε < 1› and ‹ε ≥ 0› for ε
proof -
obtain ψ where ψ: ‹norm ((A*) *⇩V ψ) ≥ norm (A*) * sqrt ε› and [simp]: ‹norm ψ = 1›
apply atomize_elim
apply (rule cblinfun_norm_approx_witness_mult[internalize_sort' 'a])
using ‹ε < 1› by (auto intro: complex_normed_vector_class.complex_normed_vector_axioms)
have ‹complex_of_real ((norm A)⇧2 * ε) = (norm (A*) * sqrt ε)⇧2›
by (simp add: ordered_field_class.sign_simps(23) that(2))
also have ‹… ≤ (norm ((A* *⇩V ψ)))⇧2›
apply (rule complex_of_real_mono)
using ψ apply (rule power_mono)
using ‹ε ≥ 0› by auto
also have ‹… ≤ cinner (A* *⇩V ψ) (A* *⇩V ψ)›
by (auto simp flip: power2_norm_eq_cinner)
also have ‹… = cinner ψ (A *⇩V A* *⇩V ψ)›
by (simp add: cinner_adj_left)
also have ‹… = cinner ψ ((A o⇩C⇩L A*) *⇩V ψ)›
by auto
also have ‹… ≤ norm (A o⇩C⇩L A*)›
using ‹norm ψ = 1›
by (smt (verit, best) Im_complex_of_real Re_complex_of_real ‹(A* *⇩V ψ) ∙⇩C (A* *⇩V ψ) = ψ ∙⇩C (A *⇩V A* *⇩V ψ)› ‹ψ ∙⇩C (A *⇩V A* *⇩V ψ) = ψ ∙⇩C ((A o⇩C⇩L A*) *⇩V ψ)› cdot_square_norm cinner_ge_zero cmod_Re complex_inner_class.Cauchy_Schwarz_ineq2 less_eq_complex_def mult_cancel_left1 mult_cancel_right1 norm_cblinfun)
finally show ?thesis
by auto
qed
then have 1: ‹(norm A)⇧2 ≤ norm (A o⇩C⇩L A*)›
by (metis field_le_mult_one_interval less_eq_real_def ordered_field_class.sign_simps(5))
have 2: ‹norm (A o⇩C⇩L A*) ≤ (norm A)⇧2›
proof (rule norm_cblinfun_bound)
show ‹0 ≤ (norm A)⇧2› by simp
fix ψ
have ‹norm ((A o⇩C⇩L A*) *⇩V ψ) = norm (A *⇩V A* *⇩V ψ)›
by auto
also have ‹… ≤ norm A * norm (A* *⇩V ψ)›
by (simp add: norm_cblinfun)
also have ‹… ≤ norm A * norm (A*) * norm ψ›
by (metis mult.assoc norm_cblinfun norm_imp_pos_and_ge ordered_comm_semiring_class.comm_mult_left_mono)
also have ‹… = (norm A)⇧2 * norm ψ›
by (simp add: power2_eq_square)
finally show ‹norm ((A o⇩C⇩L A*) *⇩V ψ) ≤ (norm A)⇧2 * norm ψ›
by -
qed
from 1 2 show ?thesis by simp
next
case False
then have [simp]: ‹class.CARD_1 TYPE('b)›
by (rule not_singleton_vs_CARD_1)
have ‹A = 0›
apply (rule cblinfun_to_CARD_1_0[internalize_sort' 'b])
by (auto intro: complex_normed_vector_class.complex_normed_vector_axioms)
then show ?thesis
by auto
qed
subsection ‹Unitaries / isometries›
definition isometry::‹'a::chilbert_space ⇒⇩C⇩L 'b::complex_inner ⇒ bool› where
‹isometry U ⟷ U* o⇩C⇩L U = id_cblinfun›
definition unitary::‹'a::chilbert_space ⇒⇩C⇩L 'b::complex_inner ⇒ bool› where
‹unitary U ⟷ (U* o⇩C⇩L U = id_cblinfun) ∧ (U o⇩C⇩L U* = id_cblinfun)›
lemma unitary_twosided_isometry: "unitary U ⟷ isometry U ∧ isometry (U*)"
unfolding unitary_def isometry_def by simp
lemma isometryD[simp]: "isometry U ⟹ U* o⇩C⇩L U = id_cblinfun"
unfolding isometry_def by simp
lemma unitaryD1: "unitary U ⟹ U* o⇩C⇩L U = id_cblinfun"
unfolding unitary_def by simp
lemma unitaryD2[simp]: "unitary U ⟹ U o⇩C⇩L U* = id_cblinfun"
unfolding unitary_def by simp
lemma unitary_isometry[simp]: "unitary U ⟹ isometry U"
unfolding unitary_def isometry_def by simp
lemma unitary_adj[simp]: "unitary (U*) = unitary U"
unfolding unitary_def by auto
lemma isometry_cblinfun_compose[simp]:
assumes "isometry A" and "isometry B"
shows "isometry (A o⇩C⇩L B)"
proof-
have "B* o⇩C⇩L A* o⇩C⇩L (A o⇩C⇩L B) = id_cblinfun" if "A* o⇩C⇩L A = id_cblinfun" and "B* o⇩C⇩L B = id_cblinfun"
using that
by (smt (verit, del_insts) adjoint_eqI cblinfun_apply_cblinfun_compose cblinfun_id_cblinfun_apply)
thus ?thesis
using assms unfolding isometry_def by simp
qed
lemma unitary_cblinfun_compose[simp]: "unitary (A o⇩C⇩L B)"
if "unitary A" and "unitary B"
using that
by (smt (z3) adj_cblinfun_compose cblinfun_compose_assoc cblinfun_compose_id_right double_adj isometryD isometry_cblinfun_compose unitary_def unitary_isometry)
lemma unitary_surj:
assumes "unitary U"
shows "surj (cblinfun_apply U)"
apply (rule surjI[where f=‹cblinfun_apply (U*)›])
using assms unfolding unitary_def apply transfer
using comp_eq_dest_lhs by force
lemma unitary_id[simp]: "unitary id_cblinfun"
by (simp add: unitary_def)
lemma orthogonal_on_basis_is_isometry:
assumes spanB: ‹ccspan B = ⊤›
assumes orthoU: ‹⋀b c. b∈B ⟹ c∈B ⟹ cinner (U *⇩V b) (U *⇩V c) = cinner b c›
shows ‹isometry U›
proof -
have [simp]: ‹b ∈ closure (cspan B)› for b
using spanB apply transfer by simp
have *: ‹cinner (U* *⇩V U *⇩V ψ) φ = cinner ψ φ› if ‹ψ∈B› and ‹φ∈B› for ψ φ
by (simp add: cinner_adj_left orthoU that(1) that(2))
have *: ‹cinner (U* *⇩V U *⇩V ψ) φ = cinner ψ φ› if ‹ψ∈B› for ψ φ
apply (rule bounded_clinear_eq_on[where t=φ and G=B])
using bounded_clinear_cinner_right *[OF that]
by auto
have ‹U* *⇩V U *⇩V φ = φ› if ‹φ∈B› for φ
apply (rule cinner_extensionality)
apply (subst cinner_eq_flip)
by (simp add: * that)
then have ‹U* o⇩C⇩L U = id_cblinfun›
by (metis cblinfun_apply_cblinfun_compose cblinfun_eq_gen_eqI cblinfun_id_cblinfun_apply spanB)
then show ‹isometry U›
using isometry_def by blast
qed
subsection ‹Images›
lift_definition cblinfun_image :: ‹'a::complex_normed_vector ⇒⇩C⇩L 'b::complex_normed_vector
⇒ 'a ccsubspace ⇒ 'b ccsubspace› (infixr "*⇩S" 70)
is "λA S. closure (A ` S)"
using bounded_clinear_def closed_closure closed_csubspace.intro
by (simp add: bounded_clinear_def complex_vector.linear_subspace_image closure_is_closed_csubspace)
lemma cblinfun_image_mono:
assumes a1: "S ≤ T"
shows "A *⇩S S ≤ A *⇩S T"
using a1
by (simp add: cblinfun_image.rep_eq closure_mono image_mono less_eq_ccsubspace.rep_eq)
lemma cblinfun_image_0[simp]:
shows "U *⇩S 0 = 0"
thm zero_ccsubspace_def
apply transfer
by (simp add: bounded_clinear_def complex_vector.linear_0)
lemma cblinfun_image_bot[simp]: "U *⇩S bot = bot"
using cblinfun_image_0 by auto
lemma cblinfun_image_sup[simp]:
fixes A B :: ‹'a::chilbert_space ccsubspace› and U :: "'a ⇒⇩C⇩L'b::chilbert_space"
shows ‹U *⇩S (sup A B) = sup (U *⇩S A) (U *⇩S B)›
apply transfer using bounded_clinear.bounded_linear closure_image_closed_sum by blast
lemma scaleC_cblinfun_image[simp]:
fixes A :: ‹'a::chilbert_space ⇒⇩C⇩L 'b :: chilbert_space›
and S :: ‹'a ccsubspace› and α :: complex
shows ‹(α *⇩C A) *⇩S S = α *⇩C (A *⇩S S)›
proof-
have ‹closure ( ( ((*⇩C) α) ∘ (cblinfun_apply A) ) ` space_as_set S) =
((*⇩C) α) ` (closure (cblinfun_apply A ` space_as_set S))›
by (metis closure_scaleC image_comp)
hence ‹(closure (cblinfun_apply (α *⇩C A) ` space_as_set S)) =
((*⇩C) α) ` (closure (cblinfun_apply A ` space_as_set S))›
by (metis (mono_tags, lifting) comp_apply image_cong scaleC_cblinfun.rep_eq)
hence ‹Abs_clinear_space (closure (cblinfun_apply (α *⇩C A) ` space_as_set S)) =
α *⇩C Abs_clinear_space (closure (cblinfun_apply A ` space_as_set S))›
by (metis space_as_set_inverse cblinfun_image.rep_eq scaleC_ccsubspace.rep_eq)
have x1: "Abs_clinear_space (closure ((*⇩V) (α *⇩C A) ` space_as_set S)) =
α *⇩C Abs_clinear_space (closure ((*⇩V) A ` space_as_set S))"
using ‹Abs_clinear_space (closure (cblinfun_apply (α *⇩C A) ` space_as_set S)) =
α *⇩C Abs_clinear_space (closure (cblinfun_apply A ` space_as_set S))›
by blast
show ?thesis
unfolding cblinfun_image_def using x1 by force
qed
lemma cblinfun_image_id[simp]:
"id_cblinfun *⇩S ψ = ψ"
apply transfer
by (simp add: closed_csubspace.closed)
lemma cblinfun_compose_image:
‹(A o⇩C⇩L B) *⇩S S = A *⇩S (B *⇩S S)›
apply transfer unfolding image_comp[symmetric]
apply (rule closure_bounded_linear_image_subset_eq[symmetric])
by (simp add: bounded_clinear.bounded_linear)
lemmas cblinfun_assoc_left = cblinfun_compose_assoc[symmetric] cblinfun_compose_image[symmetric]
add.assoc[where ?'a="'a::chilbert_space ⇒⇩C⇩L 'b::chilbert_space", symmetric]
lemmas cblinfun_assoc_right = cblinfun_compose_assoc cblinfun_compose_image
add.assoc[where ?'a="'a::chilbert_space ⇒⇩C⇩L 'b::chilbert_space"]
lemma cblinfun_image_INF_leq[simp]:
fixes U :: "'b::complex_normed_vector ⇒⇩C⇩L 'c::cbanach"
and V :: "'a ⇒ 'b ccsubspace"
shows ‹U *⇩S (INF i. V i) ≤ (INF i. U *⇩S (V i))›
apply transfer
by (simp add: INT_greatest Inter_lower closure_mono image_mono)
lemma isometry_cblinfun_image_inf_distrib':
fixes U::‹'a::complex_normed_vector ⇒⇩C⇩L 'b::cbanach› and B C::"'a ccsubspace"
shows "U *⇩S (inf B C) ≤ inf (U *⇩S B) (U *⇩S C)"
proof -
define V where ‹V b = (if b then B else C)› for b
have ‹U *⇩S (INF i. V i) ≤ (INF i. U *⇩S (V i))›
by auto
then show ?thesis
unfolding V_def
by (metis (mono_tags, lifting) INF_UNIV_bool_expand)
qed
lemma cblinfun_image_eq:
fixes S :: "'a::cbanach ccsubspace"
and A B :: "'a::cbanach ⇒⇩C⇩L'b::cbanach"
assumes "⋀x. x ∈ G ⟹ A *⇩V x = B *⇩V x" and "ccspan G ≥ S"
shows "A *⇩S S = B *⇩S S"
proof (use assms in transfer)
fix G :: "'a set" and A :: "'a ⇒ 'b" and B :: "'a ⇒ 'b" and S :: "'a set"
assume a1: "bounded_clinear A"
assume a2: "bounded_clinear B"
assume a3: "⋀x. x ∈ G ⟹ A x = B x"
assume a4: "S ⊆ closure (cspan G)"
have "A ` closure S = B ` closure S"
by (smt (verit, best) UnCI a1 a2 a3 a4 bounded_clinear_eq_on closure_Un closure_closure image_cong sup.absorb_iff1)
then show "closure (A ` S) = closure (B ` S)"
by (metis Complex_Vector_Spaces0.bounded_clinear.bounded_linear a1 a2 closure_bounded_linear_image_subset_eq)
qed
lemma cblinfun_fixes_range:
assumes "A o⇩C⇩L B = B" and "ψ ∈ space_as_set (B *⇩S top)"
shows "A *⇩V ψ = ψ"
proof-
define rangeB rangeB' where "rangeB = space_as_set (B *⇩S top)"
and "rangeB' = range (cblinfun_apply B)"
from assms have "ψ ∈ closure rangeB'"
by (simp add: cblinfun_image.rep_eq rangeB'_def top_ccsubspace.rep_eq)
then obtain ψi where ψi_lim: "ψi ⇢ ψ" and ψi_B: "ψi i ∈ rangeB'" for i
using closure_sequential by blast
have A_invariant: "A *⇩V ψi i = ψi i"
for i
proof-
from ψi_B obtain φ where φ: "ψi i = B *⇩V φ"
using rangeB'_def by blast
hence "A *⇩V ψi i = (A o⇩C⇩L B) *⇩V φ"
by (simp add: cblinfun_compose.rep_eq)
also have "… = B *⇩V φ"
by (simp add: assms)
also have "… = ψi i"
by (simp add: φ)
finally show ?thesis.
qed
from ψi_lim have "(λi. A *⇩V (ψi i)) ⇢ A *⇩V ψ"
by (rule isCont_tendsto_compose[rotated], simp)
with A_invariant have "(λi. ψi i) ⇢ A *⇩V ψ"
by auto
with ψi_lim show "A *⇩V ψ = ψ"
using LIMSEQ_unique by blast
qed
lemma zero_cblinfun_image[simp]: "0 *⇩S S = (0::_ ccsubspace)"
apply transfer by (simp add: complex_vector.subspace_0 image_constant[where x=0])
lemma cblinfun_image_INF_eq_general:
fixes V :: "'a ⇒ 'b::chilbert_space ccsubspace"
and U :: "'b ⇒⇩C⇩L'c::chilbert_space"
and Uinv :: "'c ⇒⇩C⇩L'b"
assumes UinvUUinv: "Uinv o⇩C⇩L U o⇩C⇩L Uinv = Uinv" and UUinvU: "U o⇩C⇩L Uinv o⇩C⇩L U = U"
and V: "⋀i. V i ≤ Uinv *⇩S top"
shows "U *⇩S (INF i. V i) = (INF i. U *⇩S V i)"
proof (rule antisym)
show "U *⇩S (INF i. V i) ≤ (INF i. U *⇩S V i)"
by (rule cblinfun_image_INF_leq)
next
define rangeU rangeUinv where "rangeU = U *⇩S top" and "rangeUinv = Uinv *⇩S top"
define INFUV INFV where INFUV_def: "INFUV = (INF i. U *⇩S V i)" and INFV_def: "INFV = (INF i. V i)"
from assms have "V i ≤ rangeUinv"
for i
unfolding rangeUinv_def by simp
moreover have "(Uinv o⇩C⇩L U) *⇩V ψ = ψ" if "ψ ∈ space_as_set rangeUinv"
for ψ
using UinvUUinv cblinfun_fixes_range rangeUinv_def that by fastforce
ultimately have "(Uinv o⇩C⇩L U) *⇩V ψ = ψ" if "ψ ∈ space_as_set (V i)"
for ψ i
using less_eq_ccsubspace.rep_eq that by blast
hence d1: "(Uinv o⇩C⇩L U) *⇩S (V i) = (V i)" for i
proof transfer
show "closure ((Uinv ∘ U) ` V i) = V i"
if "pred_fun ⊤ closed_csubspace V"
and "bounded_clinear Uinv"
and "bounded_clinear U"
and "⋀ψ i. ψ ∈ V i ⟹ (Uinv ∘ U) ψ = ψ"
for V :: "'a ⇒ 'b set"
and Uinv :: "'c ⇒ 'b"
and U :: "'b ⇒ 'c"
and i :: 'a
using that proof auto
show "x ∈ V i"
if "∀x. closed_csubspace (V x)"
and "bounded_clinear Uinv"
and "bounded_clinear U"
and "⋀ψ i. ψ ∈ V i ⟹ Uinv (U ψ) = ψ"
and "x ∈ closure (V i)"
for x :: 'b
using that
by (metis orthogonal_complement_of_closure closed_csubspace.subspace double_orthogonal_complement_id closure_is_closed_csubspace)
show "x ∈ closure (V i)"
if "∀x. closed_csubspace (V x)"
and "bounded_clinear Uinv"
and "bounded_clinear U"
and "⋀ψ i. ψ ∈ V i ⟹ Uinv (U ψ) = ψ"
and "x ∈ V i"
for x :: 'b
using that
using setdist_eq_0_sing_1 setdist_sing_in_set
by blast
qed
qed
have "U *⇩S V i ≤ rangeU" for i
by (simp add: cblinfun_image_mono rangeU_def)
hence "INFUV ≤ rangeU"
unfolding INFUV_def by (meson INF_lower UNIV_I order_trans)
moreover have "(U o⇩C⇩L Uinv) *⇩V ψ = ψ" if "ψ ∈ space_as_set rangeU" for ψ
using UUinvU cblinfun_fixes_range rangeU_def that by fastforce
ultimately have x: "(U o⇩C⇩L Uinv) *⇩V ψ = ψ" if "ψ ∈ space_as_set INFUV" for ψ
by (simp add: in_mono less_eq_ccsubspace.rep_eq that)
have "closure ((U ∘ Uinv) ` INFUV) = INFUV"
if "closed_csubspace INFUV"
and "bounded_clinear U"
and "bounded_clinear Uinv"
and "⋀ψ. ψ ∈ INFUV ⟹ (U ∘ Uinv) ψ = ψ"
for INFUV :: "'c set"
and U :: "'b ⇒ 'c"
and Uinv :: "'c ⇒ 'b"
using that proof auto
show "x ∈ INFUV"
if "closed_csubspace INFUV"
and "bounded_clinear U"
and "bounded_clinear Uinv"
and "⋀ψ. ψ ∈ INFUV ⟹ U (Uinv ψ) = ψ"
and "x ∈ closure INFUV"
for x :: 'c
using that
by (metis orthogonal_complement_of_closure closed_csubspace.subspace double_orthogonal_complement_id closure_is_closed_csubspace)
show "x ∈ closure INFUV"
if "closed_csubspace INFUV"
and "bounded_clinear U"
and "bounded_clinear Uinv"
and "⋀ψ. ψ ∈ INFUV ⟹ U (Uinv ψ) = ψ"
and "x ∈ INFUV"
for x :: 'c
using that
using setdist_eq_0_sing_1 setdist_sing_in_set
by (simp add: closed_csubspace.closed)
qed
hence "(U o⇩C⇩L Uinv) *⇩S INFUV = INFUV"
by (metis (mono_tags, hide_lams) x cblinfun_image.rep_eq cblinfun_image_id id_cblinfun_apply image_cong
space_as_set_inject)
hence "INFUV = U *⇩S Uinv *⇩S INFUV"
by (simp add: cblinfun_compose_image)
also have "… ≤ U *⇩S (INF i. Uinv *⇩S U *⇩S V i)"
unfolding INFUV_def
by (metis cblinfun_image_mono cblinfun_image_INF_leq)
also have "… = U *⇩S INFV"
using d1
by (metis (no_types, lifting) INFV_def cblinfun_assoc_left(2) image_cong)
finally show "INFUV ≤ U *⇩S INFV".
qed
lemma unitary_range[simp]:
assumes "unitary U"
shows "U *⇩S top = top"
using assms unfolding unitary_def apply transfer
by (metis closure_UNIV comp_apply surj_def)
lemma range_adjoint_isometry:
assumes "isometry U"
shows "U* *⇩S top = top"
proof-
from assms have "top = U* *⇩S U *⇩S top"
by (simp add: cblinfun_assoc_left(2))
also have "… ≤ U* *⇩S top"
by (simp add: cblinfun_image_mono)
finally show ?thesis
using top.extremum_unique by blast
qed
lemma cblinfun_image_INF_eq[simp]:
fixes V :: "'a ⇒ 'b::chilbert_space ccsubspace"
and U :: "'b ⇒⇩C⇩L 'c::chilbert_space"
assumes ‹isometry U›
shows "U *⇩S (INF i. V i) = (INF i. U *⇩S V i)"
proof -
from ‹isometry U› have "U* o⇩C⇩L U o⇩C⇩L U* = U*"
unfolding isometry_def by simp
moreover from ‹isometry U› have "U o⇩C⇩L U* o⇩C⇩L U = U"
unfolding isometry_def
by (simp add: cblinfun_compose_assoc)
moreover have "V i ≤ U* *⇩S top" for i
by (simp add: range_adjoint_isometry assms)
ultimately show ?thesis
by (rule cblinfun_image_INF_eq_general)
qed
lemma isometry_cblinfun_image_inf_distrib[simp]:
fixes U::‹'a::chilbert_space ⇒⇩C⇩L 'b::chilbert_space›
and X Y::"'a ccsubspace"
assumes "isometry U"
shows "U *⇩S (inf X Y) = inf (U *⇩S X) (U *⇩S Y)"
using cblinfun_image_INF_eq[where V="λb. if b then X else Y" and U=U]
unfolding INF_UNIV_bool_expand
using assms by auto
lemma cblinfun_image_ccspan:
shows "A *⇩S ccspan G = ccspan ((*⇩V) A ` G)"
apply transfer
by (simp add: bounded_clinear.bounded_linear bounded_clinear_def closure_bounded_linear_image_subset_eq complex_vector.linear_span_image)
lemma cblinfun_apply_in_image[simp]: "A *⇩V ψ ∈ space_as_set (A *⇩S ⊤)"
by (metis cblinfun_image.rep_eq closure_subset in_mono range_eqI top_ccsubspace.rep_eq)
lemma cblinfun_plus_image_distr:
‹(A + B) *⇩S S ≤ A *⇩S S ⊔ B *⇩S S›
apply transfer
by (smt (verit, ccfv_threshold) closed_closure closed_sum_def closure_minimal closure_subset image_subset_iff set_plus_intro subset_eq)
lemma cblinfun_sum_image_distr:
‹(∑i∈I. A i) *⇩S S ≤ (SUP i∈I. A i *⇩S S)›
proof (cases ‹finite I›)
case True
then show ?thesis
proof induction
case empty
then show ?case
by auto
next
case (insert x F)
then show ?case
apply auto by (smt (z3) cblinfun_plus_image_distr inf_sup_aci(6) le_iff_sup)
qed
next
case False
then show ?thesis
by auto
qed
subsection ‹Sandwiches›
lift_definition sandwich :: ‹('a::chilbert_space ⇒⇩C⇩L 'b::complex_inner) ⇒ (('a ⇒⇩C⇩L 'a) ⇒⇩C⇩L ('b ⇒⇩C⇩L 'b))› is
‹λ(A::'a⇒⇩C⇩L'b) B. A o⇩C⇩L B o⇩C⇩L A*›
proof
fix A :: ‹'a ⇒⇩C⇩L 'b› and B B1 B2 :: ‹'a ⇒⇩C⇩L 'a› and c :: complex
show ‹A o⇩C⇩L (B1 + B2) o⇩C⇩L A* = (A o⇩C⇩L B1 o⇩C⇩L A*) + (A o⇩C⇩L B2 o⇩C⇩L A*)›
by (simp add: cblinfun_compose_add_left cblinfun_compose_add_right)
show ‹A o⇩C⇩L (c *⇩C B) o⇩C⇩L A* = c *⇩C (A o⇩C⇩L B o⇩C⇩L A*)›
by auto
show ‹∃K. ∀B. norm (A o⇩C⇩L B o⇩C⇩L A*) ≤ norm B * K›
proof (rule exI[of _ ‹norm A * norm (A*)›], rule allI)
fix B
have ‹norm (A o⇩C⇩L B o⇩C⇩L A*) ≤ norm (A o⇩C⇩L B) * norm (A*)›
using norm_cblinfun_compose by blast
also have ‹… ≤ (norm A * norm B) * norm (A*)›
by (simp add: mult_right_mono norm_cblinfun_compose)
finally show ‹norm (A o⇩C⇩L B o⇩C⇩L A*) ≤ norm B * (norm A * norm (A*))›
by (simp add: mult.assoc vector_space_over_itself.scale_left_commute)
qed
qed
lemma sandwich_0[simp]: ‹sandwich 0 = 0›
by (simp add: cblinfun_eqI sandwich.rep_eq)
lemma sandwich_apply: ‹sandwich A *⇩V B = A o⇩C⇩L B o⇩C⇩L A*›
apply (transfer fixing: A B) by auto
lemma norm_sandwich: ‹norm (sandwich A) = (norm A)⇧2› for A :: ‹'a::{chilbert_space} ⇒⇩C⇩L 'b::{complex_inner}›
proof -
have main: ‹norm (sandwich A) = (norm A)⇧2› for A :: ‹'c::{chilbert_space,not_singleton} ⇒⇩C⇩L 'd::{complex_inner}›
proof (rule norm_cblinfun_eqI)
show ‹(norm A)⇧2 ≤ norm (sandwich A *⇩V id_cblinfun) / norm (id_cblinfun :: 'c ⇒⇩C⇩L _)›
apply (auto simp: sandwich_apply)
by -
fix B
have ‹norm (sandwich A *⇩V B) ≤ norm (A o⇩C⇩L B) * norm (A*)›
using norm_cblinfun_compose by (auto simp: sandwich_apply simp del: norm_adj)
also have ‹… ≤ (norm A * norm B) * norm (A*)›
by (simp add: mult_right_mono norm_cblinfun_compose)
also have ‹… ≤ (norm A)⇧2 * norm B›
by (simp add: power2_eq_square mult.assoc vector_space_over_itself.scale_left_commute)
finally show ‹norm (sandwich A *⇩V B) ≤ (norm A)⇧2 * norm B›
by -
show ‹0 ≤ (norm A)⇧2›
by auto
qed
show ?thesis
proof (cases ‹class.not_singleton TYPE('a)›)
case True
show ?thesis
apply (rule main[internalize_sort' 'c2])
apply standard[1]
using True by simp
next
case False
have ‹A = 0›
apply (rule cblinfun_from_CARD_1_0[internalize_sort' 'a])
apply (rule not_singleton_vs_CARD_1)
apply (rule False)
by standard
then show ?thesis
by simp
qed
qed
lemma sandwich_apply_adj: ‹sandwich A (B*) = (sandwich A B)*›
by (simp add: cblinfun_assoc_left(1) sandwich_apply)
lemma sandwich_id[simp]: "sandwich id_cblinfun = id_cblinfun"
apply (rule cblinfun_eqI)
by (auto simp: sandwich_apply)
subsection ‹Projectors›
lift_definition Proj :: "('a::chilbert_space) ccsubspace ⇒ 'a ⇒⇩C⇩L'a"
is ‹projection›
by (rule projection_bounded_clinear)
lemma Proj_range[simp]: "Proj S *⇩S top = S"
proof transfer
fix S :: ‹'a set› assume ‹closed_csubspace S›
then have "closure (range (projection S)) ⊆ S"
by (metis closed_csubspace.closed closed_csubspace.subspace closure_closed complex_vector.subspace_0 csubspace_is_convex dual_order.eq_iff insert_absorb insert_not_empty projection_image)
moreover have "S ⊆ closure (range (projection S))"
using ‹closed_csubspace S›
by (metis closed_csubspace_def closure_subset csubspace_is_convex equals0D projection_image subset_iff)
ultimately show ‹closure (range (projection S)) = S›
by auto
qed
lemma adj_Proj: ‹(Proj M)* = Proj M›
apply transfer by (simp add: projection_cadjoint)
lemma Proj_idempotent[simp]: ‹Proj M o⇩C⇩L Proj M = Proj M›
proof -
have u1: ‹(cblinfun_apply (Proj M)) = projection (space_as_set M)›
apply transfer
by blast
have ‹closed_csubspace (space_as_set M)›
using space_as_set by auto
hence u2: ‹(projection (space_as_set M))∘(projection (space_as_set M))
= (projection (space_as_set M))›
using projection_idem by fastforce
have ‹(cblinfun_apply (Proj M)) ∘ (cblinfun_apply (Proj M)) = cblinfun_apply (Proj M)›
using u1 u2
by simp
hence ‹cblinfun_apply ((Proj M) o⇩C⇩L (Proj M)) = cblinfun_apply (Proj M)›
by (simp add: cblinfun_compose.rep_eq)
thus ?thesis using cblinfun_apply_inject
by auto
qed
lift_definition is_Proj::‹'a::chilbert_space ⇒⇩C⇩L 'a ⇒ bool› is
‹λP. ∃M. closed_csubspace M ∧ is_projection_on P M› .
lemma Proj_on_own_range':
fixes P :: ‹'a::chilbert_space ⇒⇩C⇩L'a›
assumes ‹P o⇩C⇩L P = P› and ‹P = P*›
shows ‹Proj (P *⇩S top) = P›
proof-
define M where "M = P *⇩S top"
have v3: "x ∈ (λx. x - P *⇩V x) -` {0}"
if "x ∈ range (cblinfun_apply P)"
for x :: 'a
proof-
have v3_1: ‹cblinfun_apply P ∘ cblinfun_apply P = cblinfun_apply P›
by (metis ‹P o⇩C⇩L P = P› cblinfun_compose.rep_eq)
have ‹∃t. P *⇩V t = x›
using that by blast
then obtain t where t_def: ‹P *⇩V t = x›
by blast
hence ‹x - P *⇩V x = x - P *⇩V (P *⇩V t)›
by simp
also have ‹… = x - (P *⇩V t)›
using v3_1
by (metis comp_apply)
also have ‹… = 0›
by (simp add: t_def)
finally have ‹x - P *⇩V x = 0›
by blast
thus ?thesis
by simp
qed
have v1: "range (cblinfun_apply P) ⊆ (λx. x - cblinfun_apply P x) -` {0}"
using v3
by blast
have "x ∈ range (cblinfun_apply P)"
if "x ∈ (λx. x - P *⇩V x) -` {0}"
for x :: 'a
proof-
have x1:‹x - P *⇩V x = 0›
using that by blast
have ‹x = P *⇩V x›
by (simp add: x1 eq_iff_diff_eq_0)
thus ?thesis
by blast
qed
hence v2: "(λx. x - cblinfun_apply P x) -` {0} ⊆ range (cblinfun_apply P)"
by blast
have i1: ‹range (cblinfun_apply P) = (λ x. x - cblinfun_apply P x) -` {0}›
using v1 v2
by (simp add: v1 dual_order.antisym)
have p1: ‹closed {(0::'a)}›
by simp
have p2: ‹continuous (at x) (λ x. x - P *⇩V x)›
for x
proof-
have ‹cblinfun_apply (id_cblinfun - P) = (λ x. x - P *⇩V x)›
by (simp add: id_cblinfun.rep_eq minus_cblinfun.rep_eq)
hence ‹bounded_clinear (cblinfun_apply (id_cblinfun - P))›
using cblinfun_apply
by blast
hence ‹continuous (at x) (cblinfun_apply (id_cblinfun - P))›
by (simp add: clinear_continuous_at)
thus ?thesis
using ‹cblinfun_apply (id_cblinfun - P) = (λ x. x - P *⇩V x)›
by simp
qed
have i2: ‹closed ( (λ x. x - P *⇩V x) -` {0} )›
using p1 p2
by (rule Abstract_Topology.continuous_closed_vimage)
have ‹closed (range (cblinfun_apply P))›
using i1 i2
by simp
have u2: ‹cblinfun_apply P x ∈ space_as_set M›
for x
by (simp add: M_def ‹closed (range ((*⇩V) P))› cblinfun_image.rep_eq top_ccsubspace.rep_eq)
have xy: ‹⟨ x - P *⇩V x, y ⟩ = 0›
if y1: ‹y ∈ space_as_set M›
for x y
proof-
have ‹∃t. y = P *⇩V t›
using y1
by (simp add: M_def ‹closed (range ((*⇩V) P))› cblinfun_image.rep_eq image_iff
top_ccsubspace.rep_eq)
then obtain t where t_def: ‹y = P *⇩V t›
by blast
have ‹⟨ x - P *⇩V x, y ⟩ = ⟨ x - P *⇩V x, P *⇩V t ⟩›
by (simp add: t_def)
also have ‹… = ⟨ P *⇩V (x - P *⇩V x), t ⟩›
by (metis ‹P = P*› cinner_adj_left)
also have ‹… = ⟨ P *⇩V x - P *⇩V (P *⇩V x), t ⟩›
by (simp add: cblinfun.diff_right)
also have ‹… = ⟨ P *⇩V x - P *⇩V x, t ⟩›
by (metis assms(1) comp_apply cblinfun_compose.rep_eq)
also have ‹… = ⟨ 0, t ⟩›
by simp
also have ‹… = 0›
by simp
finally show ?thesis by blast
qed
hence u1: ‹x - P *⇩V x ∈ orthogonal_complement (space_as_set M)›
for x
by (simp add: orthogonal_complementI)
have "closed_csubspace (space_as_set M)"
using space_as_set by auto
hence f1: "(Proj M) *⇩V a = P *⇩V a" for a
by (simp add: Proj.rep_eq projection_eqI u1 u2)
have "(+) ((P - Proj M) *⇩V a) = id" for a
using f1
by (auto intro!: ext simp add: minus_cblinfun.rep_eq)
hence "b - b = cblinfun_apply (P - Proj M) a"
for a b
by (metis (no_types) add_diff_cancel_right' id_apply)
hence "cblinfun_apply (id_cblinfun - (P - Proj M)) a = a"
for a
by (simp add: id_cblinfun.rep_eq minus_cblinfun.rep_eq)
thus ?thesis
using u1 u2 cblinfun_apply_inject diff_diff_eq2 diff_eq_diff_eq eq_id_iff id_cblinfun.rep_eq
by (metis (no_types, hide_lams) M_def)
qed
lemma Proj_range_closed:
assumes "is_Proj P"
shows "closed (range (cblinfun_apply P))"
using assms apply transfer
using closed_csubspace.closed is_projection_on_image by blast
lemma Proj_is_Proj[simp]:
fixes M::‹'a::chilbert_space ccsubspace›
shows ‹is_Proj (Proj M)›
proof-
have u1: "closed_csubspace (space_as_set M)"
using space_as_set by blast
have v1: "h - Proj M *⇩V h
∈ orthogonal_complement (space_as_set M)" for h
by (simp add: Proj.rep_eq orthogonal_complementI projection_orthogonal u1)
have v2: "Proj M *⇩V h ∈ space_as_set M" for h
by (metis Proj.rep_eq mem_Collect_eq orthog_proj_exists projection_eqI space_as_set)
have u2: "is_projection_on ((*⇩V) (Proj M)) (space_as_set M)"
unfolding is_projection_on_def
by (simp add: smallest_dist_is_ortho u1 v1 v2)
show ?thesis
using u1 u2 is_Proj.rep_eq by blast
qed
lemma is_Proj_algebraic:
fixes P::‹'a::chilbert_space ⇒⇩C⇩L 'a›
shows ‹is_Proj P ⟷ P o⇩C⇩L P = P ∧ P = P*›
proof
have "P o⇩C⇩L P = P"
if "is_Proj P"
using that apply transfer
using is_projection_on_idem
by fastforce
moreover have "P = P*"
if "is_Proj P"
using that apply transfer
by (metis is_projection_on_cadjoint)
ultimately show "P o⇩C⇩L P = P ∧ P = P*"
if "is_Proj P"
using that
by blast
show "is_Proj P"
if "P o⇩C⇩L P = P ∧ P = P*"
using that Proj_on_own_range' Proj_is_Proj by metis
qed
lemma Proj_on_own_range:
fixes P :: ‹'a::chilbert_space ⇒⇩C⇩L'a›
assumes ‹is_Proj P›
shows ‹Proj (P *⇩S top) = P›
using Proj_on_own_range' assms is_Proj_algebraic by blast
lemma Proj_image_leq: "(Proj S) *⇩S A ≤ S"
by (metis Proj_range inf_top_left le_inf_iff isometry_cblinfun_image_inf_distrib')
lemma Proj_sandwich:
fixes A::"'a::chilbert_space ⇒⇩C⇩L 'b::chilbert_space"
assumes "isometry A"
shows "sandwich A *⇩V Proj S = Proj (A *⇩S S)"
proof-
define P where ‹P = A o⇩C⇩L Proj S o⇩C⇩L (A*)›
have ‹P o⇩C⇩L P = P›
using assms
unfolding P_def isometry_def
by (metis (no_types, lifting) Proj_idempotent cblinfun_assoc_left(1) cblinfun_compose_id_left)
moreover have ‹P = P*›
unfolding P_def
by (metis adj_Proj adj_cblinfun_compose cblinfun_assoc_left(1) double_adj)
ultimately have
‹∃M. P = Proj M ∧ space_as_set M = range (cblinfun_apply (A o⇩C⇩L (Proj S) o⇩C⇩L (A*)))›
using P_def Proj_on_own_range'
by (metis Proj_is_Proj Proj_range_closed cblinfun_image.rep_eq closure_closed top_ccsubspace.rep_eq)
then obtain M where ‹P = Proj M›
and ‹space_as_set M = range (cblinfun_apply (A o⇩C⇩L (Proj S) o⇩C⇩L (A*)))›
by blast
have f1: "A o⇩C⇩L Proj S = P o⇩C⇩L A"
by (simp add: P_def assms cblinfun_compose_assoc)
hence "P o⇩C⇩L A o⇩C⇩L A* = P"
using P_def by presburger
hence "(P o⇩C⇩L A) *⇩S (c ⊔ A* *⇩S d) = P *⇩S (A *⇩S c ⊔ d)"
for c d
by (simp add: cblinfun_assoc_left(2))
hence "P *⇩S (A *⇩S ⊤ ⊔ c) = (P o⇩C⇩L A) *⇩S ⊤"
for c
by (metis sup_top_left)
hence ‹M = A *⇩S S›
using f1
by (metis ‹P = Proj M› cblinfun_assoc_left(2) Proj_range sup_top_right)
thus ?thesis
using ‹P = Proj M›
unfolding P_def sandwich_apply by blast
qed
lemma Proj_orthog_ccspan_union:
assumes "⋀x y. x ∈ X ⟹ y ∈ Y ⟹ is_orthogonal x y"
shows ‹Proj (ccspan (X ∪ Y)) = Proj (ccspan X) + Proj (ccspan Y)›
proof -
have ‹x ∈ cspan X ⟹ y ∈ cspan Y ⟹ is_orthogonal x y› for x y
apply (rule is_orthogonal_closure_cspan[where X=X and Y=Y])
using closure_subset assms by auto
then have ‹x ∈ closure (cspan X) ⟹ y ∈ closure (cspan Y) ⟹ is_orthogonal x y› for x y
by (metis orthogonal_complementI orthogonal_complement_of_closure orthogonal_complement_orthoI')
then show ?thesis
apply (transfer fixing: X Y)
apply (subst projection_plus[symmetric])
by auto
qed
abbreviation proj :: "'a::chilbert_space ⇒ 'a ⇒⇩C⇩L 'a" where "proj ψ ≡ Proj (ccspan {ψ})"
lemma proj_0[simp]: ‹proj 0 = 0›
apply transfer by auto
lemma surj_isometry_is_unitary:
fixes U :: ‹'a::chilbert_space ⇒⇩C⇩L 'b::chilbert_space›
assumes ‹isometry U›
assumes ‹U *⇩S ⊤ = ⊤›
shows ‹unitary U›
by (metis Proj_sandwich sandwich_apply Proj_on_own_range' assms(1) assms(2) cblinfun_compose_id_right isometry_def unitary_def unitary_id unitary_range)
lemma ccsubspace_supI_via_Proj:
fixes A B C::"'a::chilbert_space ccsubspace"
assumes a1: ‹Proj (- C) *⇩S A ≤ B›
shows "A ≤ sup B C"
proof-
have x2: ‹x ∈ space_as_set B›
if "x ∈ closure ( (projection (orthogonal_complement (space_as_set C))) ` space_as_set A)" for x
using that
by (metis Proj.rep_eq cblinfun_image.rep_eq assms less_eq_ccsubspace.rep_eq subsetD
uminus_ccsubspace.rep_eq)
have q1: ‹x ∈ closure {ψ + φ |ψ φ. ψ ∈ space_as_set B ∧ φ ∈ space_as_set C}›
if ‹x ∈ space_as_set A›
for x
proof-
have p1: ‹closed_csubspace (space_as_set C)›
using space_as_set by auto
hence ‹x = (projection (space_as_set C)) x
+ (projection (orthogonal_complement (space_as_set C))) x›
by simp
hence ‹x = (projection (orthogonal_complement (space_as_set C))) x
+ (projection (space_as_set C)) x›
by (metis ordered_field_class.sign_simps(2))
moreover have ‹(projection (orthogonal_complement (space_as_set C))) x ∈ space_as_set B›
using x2
by (meson closure_subset image_subset_iff that)
moreover have ‹(projection (space_as_set C)) x ∈ space_as_set C›
by (metis mem_Collect_eq orthog_proj_exists projection_eqI space_as_set)
ultimately show ?thesis
using closure_subset by fastforce
qed
have x1: ‹x ∈ (space_as_set B +⇩M space_as_set C)›
if "x ∈ space_as_set A" for x
proof -
have f1: "x ∈ closure {a + b |a b. a ∈ space_as_set B ∧ b ∈ space_as_set C}"
by (simp add: q1 that)
have "{a + b |a b. a ∈ space_as_set B ∧ b ∈ space_as_set C} = {a. ∃p. p ∈ space_as_set B
∧ (∃q. q ∈ space_as_set C ∧ a = p + q)}"
by blast
hence "x ∈ closure {a. ∃b∈space_as_set B. ∃c∈space_as_set C. a = b + c}"
using f1 by (simp add: Bex_def_raw)
thus ?thesis
using that
unfolding closed_sum_def set_plus_def
by blast
qed
hence ‹x ∈ space_as_set (Abs_clinear_space (space_as_set B +⇩M space_as_set C))›
if "x ∈ space_as_set A" for x
using that
by (metis space_as_set_inverse sup_ccsubspace.rep_eq)
thus ?thesis
by (simp add: x1 less_eq_ccsubspace.rep_eq subset_eq sup_ccsubspace.rep_eq)
qed
lemma is_Proj_idempotent:
assumes "is_Proj P"
shows "P o⇩C⇩L P = P"
using assms
unfolding is_Proj_def
using assms is_Proj_algebraic by auto
lemma is_proj_selfadj:
assumes "is_Proj P"
shows "P* = P"
using assms
unfolding is_Proj_def
by (metis is_Proj_algebraic is_Proj_def)
lemma is_Proj_I:
assumes "P o⇩C⇩L P = P" and "P* = P"
shows "is_Proj P"
using assms is_Proj_algebraic by metis
lemma is_Proj_0[simp]: "is_Proj 0"
by (metis add_left_cancel adj_plus bounded_cbilinear.zero_left bounded_cbilinear_cblinfun_compose group_cancel.rule0 is_Proj_I)
lemma is_Proj_complement[simp]:
assumes a1: "is_Proj P"
shows "is_Proj (id_cblinfun-P)"
by (smt (z3) add_diff_cancel_left add_diff_cancel_left' adj_cblinfun_compose adj_plus assms bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose diff_add_cancel id_cblinfun_adjoint is_Proj_algebraic cblinfun_compose_id_left)
lemma Proj_bot[simp]: "Proj bot = 0"
by (metis zero_cblinfun_image Proj_on_own_range' is_Proj_0 is_Proj_algebraic
zero_ccsubspace_def)
lemma Proj_ortho_compl:
"Proj (- X) = id_cblinfun - Proj X"
by (transfer , auto)
lemma Proj_inj:
assumes "Proj X = Proj Y"
shows "X = Y"
by (metis assms Proj_range)
subsection ‹Kernel›
lift_definition kernel :: "'a::complex_normed_vector ⇒⇩C⇩L'b::complex_normed_vector
⇒ 'a ccsubspace"
is "λ f. f -` {0}"
by (metis kernel_is_closed_csubspace)
definition eigenspace :: "complex ⇒ 'a::complex_normed_vector ⇒⇩C⇩L'a ⇒ 'a ccsubspace" where
"eigenspace a A = kernel (A - a *⇩C id_cblinfun)"
lemma kernel_scaleC[simp]: "a≠0 ⟹ kernel (a *⇩C A) = kernel A"
for a :: complex and A :: "(_,_) cblinfun"
apply transfer
using complex_vector.scale_eq_0_iff by blast
lemma kernel_0[simp]: "kernel 0 = top"
apply transfer by auto
lemma kernel_id[simp]: "kernel id_cblinfun = 0"
apply transfer by simp
lemma eigenspace_scaleC[simp]:
assumes a1: "a ≠ 0"
shows "eigenspace b (a *⇩C A) = eigenspace (b/a) A"
proof -
have "b *⇩C (id_cblinfun::('a, _) cblinfun) = a *⇩C (b / a) *⇩C id_cblinfun"
using a1
by (metis ceq_vector_fraction_iff)
hence "kernel (a *⇩C A - b *⇩C id_cblinfun) = kernel (A - (b / a) *⇩C id_cblinfun)"
using a1 by (metis (no_types) complex_vector.scale_right_diff_distrib kernel_scaleC)
thus ?thesis
unfolding eigenspace_def
by blast
qed
lemma eigenspace_memberD:
assumes "x ∈ space_as_set (eigenspace e A)"
shows "A *⇩V x = e *⇩C x"
using assms unfolding eigenspace_def apply transfer by auto
lemma kernel_memberD:
assumes "x ∈ space_as_set (kernel A)"
shows "A *⇩V x = 0"
using assms apply transfer by auto
lemma eigenspace_memberI:
assumes "A *⇩V x = e *⇩C x"
shows "x ∈ space_as_set (eigenspace e A)"
using assms unfolding eigenspace_def apply transfer by auto
lemma kernel_memberI:
assumes "A *⇩V x = 0"
shows "x ∈ space_as_set (kernel A)"
using assms apply transfer by auto
subsection ‹Isomorphisms and inverses›
definition iso_cblinfun :: ‹('a::complex_normed_vector, 'b::complex_normed_vector) cblinfun ⇒ bool› where
‹iso_cblinfun A = (∃ B. A o⇩C⇩L B = id_cblinfun ∧ B o⇩C⇩L A = id_cblinfun)›
definition cblinfun_inv :: ‹('a::complex_normed_vector, 'b::complex_normed_vector) cblinfun ⇒ ('b,'a) cblinfun› where
‹cblinfun_inv A = (SOME B. B o⇩C⇩L A = id_cblinfun)›
lemma
assumes ‹iso_cblinfun A›
shows cblinfun_inv_left: ‹cblinfun_inv A o⇩C⇩L A = id_cblinfun›
and cblinfun_inv_right: ‹A o⇩C⇩L cblinfun_inv A = id_cblinfun›
proof -
from assms
obtain B where AB: ‹A o⇩C⇩L B = id_cblinfun› and BA: ‹B o⇩C⇩L A = id_cblinfun›
using iso_cblinfun_def by blast
from BA have ‹cblinfun_inv A o⇩C⇩L A = id_cblinfun›
by (metis (mono_tags, lifting) cblinfun_inv_def someI_ex)
with AB BA have ‹cblinfun_inv A = B›
by (metis cblinfun_assoc_left(1) cblinfun_compose_id_right)
with AB BA show ‹cblinfun_inv A o⇩C⇩L A = id_cblinfun›
and ‹A o⇩C⇩L cblinfun_inv A = id_cblinfun›
by auto
qed
lemma cblinfun_inv_uniq:
assumes "A o⇩C⇩L B = id_cblinfun" and "B o⇩C⇩L A = id_cblinfun"
shows "cblinfun_inv A = B"
using assms by (metis cblinfun_compose_assoc cblinfun_compose_id_right cblinfun_inv_left iso_cblinfun_def)
subsection ‹One-dimensional spaces›
instantiation cblinfun :: (one_dim, one_dim) complex_inner begin
text ‹Once we have a theory for the trace, we could instead define the Hilbert-Schmidt inner product
and relax the \<^class>‹one_dim›-sort constraint to (\<^class>‹cfinite_dim›,\<^class>‹complex_normed_vector›) or similar›
definition "cinner_cblinfun (A::'a ⇒⇩C⇩L 'b) (B::'a ⇒⇩C⇩L 'b)
= cnj (one_dim_iso (A *⇩V 1)) * one_dim_iso (B *⇩V 1)"
instance
proof intro_classes
fix A B C :: "'a ⇒⇩C⇩L 'b"
and c c' :: complex
show "⟨A, B⟩ = cnj ⟨B, A⟩"
unfolding cinner_cblinfun_def by auto
show "⟨A + B, C⟩ = ⟨A, C⟩ + ⟨B, C⟩"
by (simp add: cinner_cblinfun_def algebra_simps plus_cblinfun.rep_eq)
show "⟨c *⇩C A, B⟩ = cnj c * ⟨A, B⟩"
by (simp add: cblinfun.scaleC_left cinner_cblinfun_def)
show "0 ≤ ⟨A, A⟩"
unfolding cinner_cblinfun_def by auto
have "bounded_clinear A ⟹ A 1 = 0 ⟹ A = (λ_. 0)"
for A::"'a ⇒ 'b"
proof (rule one_dim_clinear_eqI [where x = 1] , auto)
show "clinear A"
if "bounded_clinear A"
and "A 1 = 0"
for A :: "'a ⇒ 'b"
using that
by (simp add: bounded_clinear.clinear)
show "clinear ((λ_. 0)::'a ⇒ 'b)"
if "bounded_clinear A"
and "A 1 = 0"
for A :: "'a ⇒ 'b"
using that
by (simp add: complex_vector.module_hom_zero)
qed
hence "A *⇩V 1 = 0 ⟹ A = 0"
by transfer
hence "one_dim_iso (A *⇩V 1) = 0 ⟹ A = 0"
by (metis one_dim_iso_of_zero one_dim_iso_inj)
thus "(⟨A, A⟩ = 0) = (A = 0)"
by (auto simp: cinner_cblinfun_def)
show "norm A = sqrt (cmod ⟨A, A⟩)"
unfolding cinner_cblinfun_def
apply transfer
by (simp add: norm_mult abs_complex_def one_dim_onorm' cnj_x_x power2_eq_square bounded_clinear.clinear)
qed
end
instantiation cblinfun :: (one_dim, one_dim) one_dim begin
lift_definition one_cblinfun :: "'a ⇒⇩C⇩L 'b" is "one_dim_iso"
by (rule bounded_clinear_one_dim_iso)
lift_definition times_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b"
is "λf g. f o one_dim_iso o g"
by (simp add: comp_bounded_clinear)
lift_definition inverse_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b" is
"λf. ((*) (one_dim_iso (inverse (f 1)))) o one_dim_iso"
by (auto intro!: comp_bounded_clinear bounded_clinear_mult_right)
definition divide_cblinfun :: "'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b ⇒ 'a ⇒⇩C⇩L 'b" where
"divide_cblinfun A B = A * inverse B"
definition "canonical_basis_cblinfun = [1 :: 'a ⇒⇩C⇩L 'b]"
instance
proof intro_classes
let ?basis = "canonical_basis :: ('a ⇒⇩C⇩L 'b) list"
fix A B C :: "'a ⇒⇩C⇩L 'b"
and c c' :: complex
show "distinct ?basis"
unfolding canonical_basis_cblinfun_def by simp
have "(1::'a ⇒⇩C⇩L 'b) ≠ (0::'a ⇒⇩C⇩L 'b)"
by (metis cblinfun.zero_left one_cblinfun.rep_eq one_dim_iso_of_one zero_neq_one)
thus "cindependent (set ?basis)"
unfolding canonical_basis_cblinfun_def by simp
have "A ∈ cspan (set ?basis)" for A
proof -
define c :: complex where "c = one_dim_iso (A *⇩V 1)"
have "A x = one_dim_iso (A 1) *⇩C one_dim_iso x" for x
by (smt (z3) cblinfun.scaleC_right complex_vector.scale_left_commute one_dim_iso_idem one_dim_scaleC_1)
hence "A = one_dim_iso (A *⇩V 1) *⇩C 1"
apply transfer by metis
thus "A ∈ cspan (set ?basis)"
unfolding canonical_basis_cblinfun_def
by (smt complex_vector.span_base complex_vector.span_scale list.set_intros(1))
qed
thus "cspan (set ?basis) = UNIV" by auto
have "A = (1::'a ⇒⇩C⇩L 'b) ⟹
norm (1::'a ⇒⇩C⇩L 'b) = (1::real)"
apply transfer by simp
thus "A ∈ set ?basis ⟹ norm A = 1"
unfolding canonical_basis_cblinfun_def
by simp
show "?basis = [1]"
unfolding canonical_basis_cblinfun_def by simp
show "c *⇩C 1 * c' *⇩C 1 = (c * c') *⇩C (1::'a⇒⇩C⇩L'b)"
apply transfer by auto
have "(1::'a ⇒⇩C⇩L 'b) = (0::'a ⇒⇩C⇩L 'b) ⟹ False"
by (metis cblinfun.zero_left one_cblinfun.rep_eq one_dim_iso_of_zero' zero_neq_neg_one)
thus "is_ortho_set (set ?basis)"
unfolding is_ortho_set_def canonical_basis_cblinfun_def by auto
show "A div B = A * inverse B"
by (simp add: divide_cblinfun_def)
show "inverse (c *⇩C 1) = (1::'a⇒⇩C⇩L'b) /⇩C c"
apply transfer by (simp add: o_def one_dim_inverse)
qed
end
lemma id_cblinfun_eq_1[simp]: ‹id_cblinfun = 1›
apply transfer by auto
lemma one_dim_apply_is_times[simp]:
fixes A :: "'a::one_dim ⇒⇩C⇩L 'a" and B :: "'a ⇒⇩C⇩L 'a"
shows "A o⇩C⇩L B = A * B"
apply transfer by simp
lemma one_comp_one_cblinfun[simp]: "1 o⇩C⇩L 1 = 1"
apply transfer unfolding o_def by simp
lemma one_cblinfun_adj[simp]: "1* = 1"
apply transfer by simp
lemma scaleC_1_right[simp]: ‹scaleC x (1::'a::one_dim) = of_complex x›
unfolding of_complex_def by simp
lemma scaleC_of_complex[simp]: ‹scaleC x (of_complex y) = of_complex (x * y)›
unfolding of_complex_def using scaleC_scaleC by blast
lemma scaleC_1_apply[simp]: ‹(x *⇩C 1) *⇩V y = x *⇩C y›
by (metis cblinfun.scaleC_left cblinfun_id_cblinfun_apply id_cblinfun_eq_1)
lemma cblinfun_apply_1_left[simp]: ‹1 *⇩V y = y›
by (metis cblinfun_id_cblinfun_apply id_cblinfun_eq_1)
lemma of_complex_cblinfun_apply[simp]: ‹of_complex x *⇩V y = x *⇩C y›
unfolding of_complex_def
by (metis cblinfun.scaleC_left cblinfun_id_cblinfun_apply id_cblinfun_eq_1)
lemma cblinfun_compose_1_left[simp]: ‹1 o⇩C⇩L x = x›
apply transfer by auto
lemma cblinfun_compose_1_right[simp]: ‹x o⇩C⇩L 1 = x›
apply transfer by auto
lemma one_dim_iso_id_cblinfun: ‹one_dim_iso id_cblinfun = id_cblinfun›
by simp
lemma one_dim_iso_id_cblinfun_eq_1: ‹one_dim_iso id_cblinfun = 1›
by simp
lemma one_dim_iso_comp_distr[simp]: ‹one_dim_iso (a o⇩C⇩L b) = one_dim_iso a o⇩C⇩L one_dim_iso b›
by (smt (z3) cblinfun_compose_scaleC_left cblinfun_compose_scaleC_right one_cinner_a_scaleC_one one_comp_one_cblinfun one_dim_iso_of_one one_dim_iso_scaleC)
lemma one_dim_iso_comp_distr_times[simp]: ‹one_dim_iso (a o⇩C⇩L b) = one_dim_iso a * one_dim_iso b›
by (smt (verit, del_insts) mult.left_neutral mult_scaleC_left one_cinner_a_scaleC_one one_comp_one_cblinfun one_dim_iso_of_one one_dim_iso_scaleC cblinfun_compose_scaleC_right cblinfun_compose_scaleC_left)
lemma one_dim_iso_adjoint[simp]: ‹one_dim_iso (A*) = (one_dim_iso A)*›
by (smt (z3) one_cblinfun_adj one_cinner_a_scaleC_one one_dim_iso_of_one one_dim_iso_scaleC scaleC_adj)
lemma one_dim_iso_adjoint_complex[simp]: ‹one_dim_iso (A*) = cnj (one_dim_iso A)›
by (metis (mono_tags, lifting) one_cblinfun_adj one_dim_iso_idem one_dim_scaleC_1 scaleC_adj)
lemma one_dim_cblinfun_compose_commute: ‹a o⇩C⇩L b = b o⇩C⇩L a› for a b :: ‹('a::one_dim,'a) cblinfun›
by (simp add: one_dim_iso_inj)
lemma one_cblinfun_apply_one[simp]: ‹1 *⇩V 1 = 1›
by (simp add: one_cblinfun.rep_eq)
subsection ‹Loewner order›
lift_definition heterogenous_cblinfun_id :: ‹'a::complex_normed_vector ⇒⇩C⇩L 'b::complex_normed_vector›
is ‹if bounded_clinear (heterogenous_identity :: 'a::complex_normed_vector ⇒ 'b::complex_normed_vector) then heterogenous_identity else (λ_. 0)›
by auto
lemma heterogenous_cblinfun_id_def'[simp]: "heterogenous_cblinfun_id = id_cblinfun"
apply transfer by auto
definition "heterogenous_same_type_cblinfun (x::'a::chilbert_space itself) (y::'b::chilbert_space itself) ⟷
unitary (heterogenous_cblinfun_id :: 'a ⇒⇩C⇩L 'b) ∧ unitary (heterogenous_cblinfun_id :: 'b ⇒⇩C⇩L 'a)"
lemma heterogenous_same_type_cblinfun[simp]: ‹heterogenous_same_type_cblinfun (x::'a::chilbert_space itself) (y::'a::chilbert_space itself)›
unfolding heterogenous_same_type_cblinfun_def by auto
instantiation cblinfun :: (chilbert_space, chilbert_space) ord begin
definition less_eq_cblinfun :: ‹('a ⇒⇩C⇩L 'b) ⇒ ('a ⇒⇩C⇩L 'b) ⇒ bool›
where less_eq_cblinfun_def_heterogenous: ‹less_eq_cblinfun A B =
(if heterogenous_same_type_cblinfun TYPE('a) TYPE('b) then
∀ψ::'b. cinner ψ ((B-A) *⇩V heterogenous_cblinfun_id *⇩V ψ) ≥ 0 else (A=B))›
definition ‹less_cblinfun (A :: 'a ⇒⇩C⇩L 'b) B ⟷ A ≤ B ∧ ¬ B ≤ A›
instance..
end
lemma less_eq_cblinfun_def: ‹A ≤ B ⟷
(∀ψ. cinner ψ (A *⇩V ψ) ≤ cinner ψ (B *⇩V ψ))›
unfolding less_eq_cblinfun_def_heterogenous
by (auto simp del: less_eq_complex_def simp: cblinfun.diff_left cinner_diff_right)
instantiation cblinfun :: (chilbert_space, chilbert_space) ordered_complex_vector begin
instance
proof intro_classes
note less_eq_complex_def[simp del]
fix x y z :: ‹'a ⇒⇩C⇩L 'b›
fix a b :: complex
define pos where ‹pos X ⟷ (∀ψ. cinner ψ (X *⇩V ψ) ≥ 0)› for X :: ‹'b ⇒⇩C⇩L 'b›
consider (unitary) ‹heterogenous_same_type_cblinfun TYPE('a) TYPE('b)›
‹⋀A B :: 'a ⇒⇩C⇩L 'b. A ≤ B = pos ((B-A) o⇩C⇩L (heterogenous_cblinfun_id :: 'b⇒⇩C⇩L'a))›
| (trivial) ‹⋀A B :: 'a ⇒⇩C⇩L 'b. A ≤ B ⟷ A = B›
apply atomize_elim by (auto simp: pos_def less_eq_cblinfun_def_heterogenous)
note cases = this
have [simp]: ‹pos 0›
unfolding pos_def by auto
have pos_nondeg: ‹X = 0› if ‹pos X› and ‹pos (-X)› for X
apply (rule cblinfun_cinner_eqI, simp)
using that by (metis (no_types, lifting) cblinfun.minus_left cinner_minus_right dual_order.antisym equation_minus_iff neg_le_0_iff_le pos_def)
have pos_add: ‹pos (X+Y)› if ‹pos X› and ‹pos Y› for X Y
by (smt (z3) pos_def cblinfun.diff_left cinner_minus_right cinner_simps(3) diff_ge_0_iff_ge diff_minus_eq_add neg_le_0_iff_le order_trans that(1) that(2) uminus_cblinfun.rep_eq)
have pos_scaleC: ‹pos (a *⇩C X)› if ‹a≥0› and ‹pos X› for X a
using that unfolding pos_def by (auto simp: cblinfun.scaleC_left)
let ?id = ‹heterogenous_cblinfun_id :: 'b ⇒⇩C⇩L 'a›
show ‹x ≤ x›
apply (cases rule:cases) by auto
show ‹(x < y) ⟷ (x ≤ y ∧ ¬ y ≤ x)›
unfolding less_cblinfun_def by simp
show ‹x ≤ z› if ‹x ≤ y› and ‹y ≤ z›
proof (cases rule:cases)
case unitary
define a b :: ‹'b ⇒⇩C⇩L 'b› where ‹a = (y-x) o⇩C⇩L heterogenous_cblinfun_id›
and ‹b = (z-y) o⇩C⇩L heterogenous_cblinfun_id›
with unitary that have ‹pos a› and ‹pos b›
by auto
then have ‹pos (a + b)›
by (rule pos_add)
moreover have ‹a + b = (z - x) o⇩C⇩L heterogenous_cblinfun_id›
unfolding a_def b_def
by (metis (no_types, lifting) bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose diff_add_cancel ordered_field_class.sign_simps(2) ordered_field_class.sign_simps(8))
ultimately show ?thesis
using unitary by auto
next
case trivial
with that show ?thesis by auto
qed
show ‹x = y› if ‹x ≤ y› and ‹y ≤ x›
proof (cases rule:cases)
case unitary
then have ‹unitary ?id›
by (auto simp: heterogenous_same_type_cblinfun_def)
define a b :: ‹'b ⇒⇩C⇩L 'b› where ‹a = (y-x) o⇩C⇩L ?id›
and ‹b = (x-y) o⇩C⇩L ?id›
with unitary that have ‹pos a› and ‹pos b›
by auto
then have ‹a = 0›
apply (rule_tac pos_nondeg)
apply (auto simp: a_def b_def)
by (smt (verit, best) add.commute bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose cblinfun_compose_zero_left diff_0 diff_add_cancel group_cancel.rule0 group_cancel.sub1)
then show ?thesis
unfolding a_def using ‹unitary ?id›
by (metis cblinfun_compose_assoc cblinfun_compose_id_right cblinfun_compose_zero_left eq_iff_diff_eq_0 unitaryD2)
next
case trivial
with that show ?thesis by simp
qed
show ‹x + y ≤ x + z› if ‹y ≤ z›
proof (cases rule:cases)
case unitary
with that show ?thesis
by auto
next
case trivial
with that show ?thesis
by auto
qed
show ‹a *⇩C x ≤ a *⇩C y› if ‹x ≤ y› and ‹0 ≤ a›
proof (cases rule:cases)
case unitary
with that pos_scaleC show ?thesis
by (metis cblinfun_compose_scaleC_left complex_vector.scale_right_diff_distrib)
next
case trivial
with that show ?thesis
by auto
qed
show ‹a *⇩C x ≤ b *⇩C x› if ‹a ≤ b› and ‹0 ≤ x›
proof (cases rule:cases)
case unitary
with that show ?thesis
by (auto intro!: pos_scaleC simp flip: scaleC_diff_left)
next
case trivial
with that show ?thesis
by auto
qed
qed
end
lemma positive_id_cblinfun[simp]: "id_cblinfun ≥ 0"
unfolding less_eq_cblinfun_def using cinner_ge_zero by auto
lemma positive_hermitianI: ‹A = A*› if ‹A ≥ 0›
apply (rule cinner_real_hermiteanI)
using that by (auto simp del: less_eq_complex_def simp: reals_zero_comparable_iff less_eq_cblinfun_def)
lemma positive_cblinfunI: ‹A ≥ 0› if ‹⋀x. cinner x (A *⇩V x) ≥ 0›
unfolding less_eq_cblinfun_def using that by auto
lemma positive_cblinfun_squareI: ‹A = B* o⇩C⇩L B ⟹ A ≥ 0›
apply (rule positive_cblinfunI)
by (metis cblinfun_apply_cblinfun_compose cinner_adj_right cinner_ge_zero)
lemma one_dim_loewner_order: ‹A ≥ B ⟷ one_dim_iso A ≥ (one_dim_iso B :: complex)› for A B :: ‹'a ⇒⇩C⇩L 'a::{chilbert_space, one_dim}›
proof -
note less_eq_complex_def[simp del]
have A: ‹A = one_dim_iso A *⇩C id_cblinfun›
by simp
have B: ‹B = one_dim_iso B *⇩C id_cblinfun›
by simp
have ‹A ≥ B ⟷ (∀ψ. cinner ψ (A ψ) ≥ cinner ψ (B ψ))›
by (simp add: less_eq_cblinfun_def)
also have ‹… ⟷ (∀ψ::'a. one_dim_iso B * (ψ ∙⇩C ψ) ≤ one_dim_iso A * (ψ ∙⇩C ψ))›
apply (subst A, subst B)
by (metis (no_types, hide_lams) cinner_scaleC_right id_cblinfun_apply scaleC_cblinfun.rep_eq)
also have ‹… ⟷ one_dim_iso A ≥ (one_dim_iso B :: complex)›
by (auto intro!: mult_right_mono elim!: allE[where x=1])
finally show ?thesis
by -
qed
lemma one_dim_positive: ‹A ≥ 0 ⟷ one_dim_iso A ≥ (0::complex)› for A :: ‹'a ⇒⇩C⇩L 'a::{chilbert_space, one_dim}›
using one_dim_loewner_order[where B=0] by auto
subsection ‹Embedding vectors to operators›
lift_definition vector_to_cblinfun :: ‹'a::complex_normed_vector ⇒ 'b::one_dim ⇒⇩C⇩L 'a› is
‹λψ φ. one_dim_iso φ *⇩C ψ›
by (simp add: bounded_clinear_scaleC_const)
lemma vector_to_cblinfun_cblinfun_apply:
"vector_to_cblinfun (A *⇩V ψ) = A o⇩C⇩L (vector_to_cblinfun ψ)"
apply transfer
unfolding comp_def bounded_clinear_def clinear_def Vector_Spaces.linear_def
module_hom_def module_hom_axioms_def
by simp
lemma vector_to_cblinfun_add: ‹vector_to_cblinfun (x + y) = vector_to_cblinfun x + vector_to_cblinfun y›
apply transfer
by (simp add: scaleC_add_right)
lemma norm_vector_to_cblinfun[simp]: "norm (vector_to_cblinfun x) = norm x"
proof transfer
have "bounded_clinear (one_dim_iso::'a ⇒ complex)"
by simp
moreover have "onorm (one_dim_iso::'a ⇒ complex) * norm x = norm x"
for x :: 'b
by simp
ultimately show "onorm (λφ. one_dim_iso (φ::'a) *⇩C x) = norm x"
for x :: 'b
by (subst onorm_scaleC_left)
qed
lemma bounded_clinear_vector_to_cblinfun[bounded_clinear]: "bounded_clinear vector_to_cblinfun"
apply (rule bounded_clinearI[where K=1])
apply (transfer, simp add: scaleC_add_right)
apply (transfer, simp add: mult.commute)
by simp
lemma vector_to_cblinfun_scaleC[simp]:
"vector_to_cblinfun (a *⇩C ψ) = a *⇩C vector_to_cblinfun ψ" for a::complex
proof (subst asm_rl [of "a *⇩C ψ = (a *⇩C id_cblinfun) *⇩V ψ"])
show "a *⇩C ψ = a *⇩C id_cblinfun *⇩V ψ"
by (simp add: scaleC_cblinfun.rep_eq)
show "vector_to_cblinfun (a *⇩C id_cblinfun *⇩V ψ) = a *⇩C (vector_to_cblinfun ψ::'a ⇒⇩C⇩L 'b)"
by (metis cblinfun_id_cblinfun_apply cblinfun_compose_scaleC_left vector_to_cblinfun_cblinfun_apply)
qed
lemma vector_to_cblinfun_apply_one_dim[simp]:
shows "vector_to_cblinfun φ *⇩V γ = one_dim_iso γ *⇩C φ"
apply transfer by (rule refl)
lemma vector_to_cblinfun_adj_apply[simp]:
shows "vector_to_cblinfun ψ* *⇩V φ = of_complex (cinner ψ φ)"
by (simp add: cinner_adj_right one_dim_iso_def one_dim_iso_inj)
lemma vector_to_cblinfun_comp_one[simp]:
"(vector_to_cblinfun s :: 'a::one_dim ⇒⇩C⇩L _) o⇩C⇩L 1
= (vector_to_cblinfun s :: 'b::one_dim ⇒⇩C⇩L _)"
apply (transfer fixing: s)
by fastforce
lemma vector_to_cblinfun_0[simp]: "vector_to_cblinfun 0 = 0"
by (metis cblinfun.zero_left cblinfun_compose_zero_left vector_to_cblinfun_cblinfun_apply)
lemma image_vector_to_cblinfun[simp]: "vector_to_cblinfun x *⇩S top = ccspan {x}"
proof transfer
show "closure (range (λφ::'b. one_dim_iso φ *⇩C x)) = closure (cspan {x})"
for x :: 'a
proof (rule arg_cong [where f = closure])
have "k *⇩C x ∈ range (λφ. one_dim_iso φ *⇩C x)" for k
by (smt (z3) id_apply one_dim_iso_id one_dim_iso_idem range_eqI)
thus "range (λφ. one_dim_iso (φ::'b) *⇩C x) = cspan {x}"
unfolding complex_vector.span_singleton
by auto
qed
qed
lemma vector_to_cblinfun_adj_comp_vector_to_cblinfun[simp]:
shows "vector_to_cblinfun ψ* o⇩C⇩L vector_to_cblinfun φ = cinner ψ φ *⇩C id_cblinfun"
proof -
have "one_dim_iso γ *⇩C one_dim_iso (of_complex ⟨ψ, φ⟩) =
⟨ψ, φ⟩ *⇩C one_dim_iso γ"
for γ :: "'c::one_dim"
by (metis complex_vector.scale_left_commute of_complex_def one_dim_iso_of_one one_dim_iso_scaleC one_dim_scaleC_1)
hence "one_dim_iso ((vector_to_cblinfun ψ* o⇩C⇩L vector_to_cblinfun φ) *⇩V γ)
= one_dim_iso ((cinner ψ φ *⇩C id_cblinfun) *⇩V γ)"
for γ :: "'c::one_dim"
by simp
hence "((vector_to_cblinfun ψ* o⇩C⇩L vector_to_cblinfun φ) *⇩V γ) = ((cinner ψ φ *⇩C id_cblinfun) *⇩V γ)"
for γ :: "'c::one_dim"
by (rule one_dim_iso_inj)
thus ?thesis
using cblinfun_eqI[where x = "vector_to_cblinfun ψ* o⇩C⇩L vector_to_cblinfun φ"
and y = "⟨ψ, φ⟩ *⇩C id_cblinfun"]
by auto
qed
lemma isometry_vector_to_cblinfun[simp]:
assumes "norm x = 1"
shows "isometry (vector_to_cblinfun x)"
using assms cnorm_eq_1 isometry_def by force
subsection ‹Butterflies (rank-1 projectors)›
definition butterfly_def: "butterfly (s::'a::complex_normed_vector) (t::'b::chilbert_space)
= vector_to_cblinfun s o⇩C⇩L (vector_to_cblinfun t :: complex ⇒⇩C⇩L _)*"
abbreviation "selfbutter s ≡ butterfly s s"
lemma butterfly_add_left: ‹butterfly (a + a') b = butterfly a b + butterfly a' b›
by (simp add: butterfly_def vector_to_cblinfun_add cbilinear_add_left bounded_cbilinear.add_left bounded_cbilinear_cblinfun_compose)
lemma butterfly_add_right: ‹butterfly a (b + b') = butterfly a b + butterfly a b'›
by (simp add: butterfly_def adj_plus vector_to_cblinfun_add cblinfun_compose_add_right)
lemma butterfly_def_one_dim: "butterfly s t = (vector_to_cblinfun s :: 'c::one_dim ⇒⇩C⇩L _)
o⇩C⇩L (vector_to_cblinfun t :: 'c ⇒⇩C⇩L _)*"
(is "_ = ?rhs") for s :: "'a::complex_normed_vector" and t :: "'b::chilbert_space"
proof -
let ?isoAC = "1 :: 'c ⇒⇩C⇩L complex"
let ?isoCA = "1 :: complex ⇒⇩C⇩L 'c"
let ?vector = "vector_to_cblinfun :: _ ⇒ ('c ⇒⇩C⇩L _)"
have "butterfly s t =
(?vector s o⇩C⇩L ?isoCA) o⇩C⇩L (?vector t o⇩C⇩L ?isoCA)*"
unfolding butterfly_def vector_to_cblinfun_comp_one by simp
also have "… = ?vector s o⇩C⇩L (?isoCA o⇩C⇩L ?isoCA*) o⇩C⇩L (?vector t)*"
by (metis (no_types, lifting) cblinfun_compose_assoc adj_cblinfun_compose)
also have "… = ?rhs"
by simp
finally show ?thesis
by simp
qed
lemma butterfly_comp_cblinfun: "butterfly ψ φ o⇩C⇩L a = butterfly ψ (a* *⇩V φ)"
unfolding butterfly_def
by (simp add: cblinfun_compose_assoc vector_to_cblinfun_cblinfun_apply)
lemma cblinfun_comp_butterfly: "a o⇩C⇩L butterfly ψ φ = butterfly (a *⇩V ψ) φ"
unfolding butterfly_def
by (simp add: cblinfun_compose_assoc vector_to_cblinfun_cblinfun_apply)
lemma butterfly_apply[simp]: "butterfly ψ ψ' *⇩V φ = ⟨ψ', φ⟩ *⇩C ψ"
by (simp add: butterfly_def scaleC_cblinfun.rep_eq)
lemma butterfly_scaleC_left[simp]: "butterfly (c *⇩C ψ) φ = c *⇩C butterfly ψ φ"
unfolding butterfly_def vector_to_cblinfun_scaleC scaleC_adj
by (simp add: cnj_x_x)
lemma butterfly_scaleC_right[simp]: "butterfly ψ (c *⇩C φ) = cnj c *⇩C butterfly ψ φ"
unfolding butterfly_def vector_to_cblinfun_scaleC scaleC_adj
by (simp add: cnj_x_x)
lemma butterfly_scaleR_left[simp]: "butterfly (r *⇩R ψ) φ = r *⇩C butterfly ψ φ"
by (simp add: scaleR_scaleC)
lemma butterfly_scaleR_right[simp]: "butterfly ψ (r *⇩R φ) = r *⇩C butterfly ψ φ"
by (simp add: butterfly_scaleC_right scaleR_scaleC)
lemma butterfly_adjoint[simp]: "(butterfly ψ φ)* = butterfly φ ψ"
unfolding butterfly_def by auto
lemma butterfly_comp_butterfly[simp]: "butterfly ψ1 ψ2 o⇩C⇩L butterfly ψ3 ψ4 = ⟨ψ2, ψ3⟩ *⇩C butterfly ψ1 ψ4"
by (simp add: butterfly_comp_cblinfun)
lemma butterfly_0_left[simp]: "butterfly 0 a = 0"
by (simp add: butterfly_def)
lemma butterfly_0_right[simp]: "butterfly a 0 = 0"
by (simp add: butterfly_def)
lemma norm_butterfly: "norm (butterfly ψ φ) = norm ψ * norm φ"
proof (cases "φ=0")
case True
then show ?thesis by simp
next
case False
show ?thesis
unfolding norm_cblinfun.rep_eq
thm onormI[OF _ False]
proof (rule onormI[OF _ False])
fix x
have "cmod ⟨φ, x⟩ * norm ψ ≤ norm ψ * norm φ * norm x"
by (metis ab_semigroup_mult_class.mult_ac(1) complex_inner_class.Cauchy_Schwarz_ineq2 mult.commute mult_left_mono norm_ge_zero)
thus "norm (butterfly ψ φ *⇩V x) ≤ norm ψ * norm φ * norm x"
by (simp add: power2_eq_square)
show "norm (butterfly ψ φ *⇩V φ) = norm ψ * norm φ * norm φ"
by (smt (z3) ab_semigroup_mult_class.mult_ac(1) butterfly_apply mult.commute norm_eq_sqrt_cinner norm_ge_zero norm_scaleC power2_eq_square real_sqrt_abs real_sqrt_eq_iff)
qed
qed
lemma bounded_sesquilinear_butterfly[bounded_sesquilinear]: ‹bounded_sesquilinear (λ(b::'b::chilbert_space) (a::'a::chilbert_space). butterfly a b)›
proof standard
fix a a' :: 'a and b b' :: 'b and r :: complex
show ‹butterfly (a + a') b = butterfly a b + butterfly a' b›
by (rule butterfly_add_left)
show ‹butterfly a (b + b') = butterfly a b + butterfly a b'›
by (rule butterfly_add_right)
show ‹butterfly (r *⇩C a) b = r *⇩C butterfly a b›
by simp
show ‹butterfly a (r *⇩C b) = cnj r *⇩C butterfly a b›
by simp
show ‹∃K. ∀b a. norm (butterfly a b) ≤ norm b * norm a * K ›
apply (rule exI[of _ 1])
by (simp add: norm_butterfly)
qed
lemma inj_selfbutter_upto_phase:
assumes "selfbutter x = selfbutter y"
shows "∃c. cmod c = 1 ∧ x = c *⇩C y"
proof (cases "x = 0")
case True
from assms have "y = 0"
using norm_butterfly
by (metis True butterfly_0_left divisors_zero norm_eq_zero)
with True show ?thesis
using norm_one by fastforce
next
case False
define c where "c = ⟨y, x⟩ / ⟨x, x⟩"
have "⟨x, x⟩ *⇩C x = selfbutter x *⇩V x"
by (simp add: butterfly_apply)
also have "… = selfbutter y *⇩V x"
using assms by simp
also have "… = ⟨y, x⟩ *⇩C y"
by (simp add: butterfly_apply)
finally have xcy: "x = c *⇩C y"
by (simp add: c_def ceq_vector_fraction_iff)
have "cmod c * norm x = cmod c * norm y"
using assms norm_butterfly
by (smt (verit, ccfv_SIG) ‹⟨x, x⟩ *⇩C x = selfbutter x *⇩V x› ‹selfbutter y *⇩V x = ⟨y, x⟩ *⇩C y› cinner_scaleC_right complex_vector.scale_left_commute complex_vector.scale_right_imp_eq mult_cancel_left norm_eq_sqrt_cinner norm_eq_zero scaleC_scaleC xcy)
also have "cmod c * norm y = norm (c *⇩C y)"
by simp
also have "… = norm x"
unfolding xcy[symmetric] by simp
finally have c: "cmod c = 1"
by (simp add: False)
from c xcy show ?thesis
by auto
qed
lemma butterfly_eq_proj:
assumes "norm x = 1"
shows "selfbutter x = proj x"
proof -
define B and φ :: "complex ⇒⇩C⇩L 'a"
where "B = selfbutter x" and "φ = vector_to_cblinfun x"
then have B: "B = φ o⇩C⇩L φ*"
unfolding butterfly_def by simp
have φadjφ: "φ* o⇩C⇩L φ = id_cblinfun"
using φ_def assms isometry_def isometry_vector_to_cblinfun by blast
have "B o⇩C⇩L B = φ o⇩C⇩L (φ* o⇩C⇩L φ) o⇩C⇩L φ*"
by (simp add: B cblinfun_assoc_left(1))
also have "… = B"
unfolding φadjφ by (simp add: B)
finally have idem: "B o⇩C⇩L B = B".
have herm: "B = B*"
unfolding B by simp
from idem herm have BProj: "B = Proj (B *⇩S top)"
by (rule Proj_on_own_range'[symmetric])
have "B *⇩S top = ccspan {x}"
by (simp add: B φ_def assms cblinfun_compose_image range_adjoint_isometry)
with BProj show "B = proj x"
by simp
qed
lemma butterfly_is_Proj:
‹norm x = 1 ⟹ is_Proj (selfbutter x)›
by (subst butterfly_eq_proj, simp_all)
lemma cspan_butterfly_UNIV:
assumes ‹cspan basisA = UNIV›
assumes ‹cspan basisB = UNIV›
assumes ‹is_ortho_set basisB›
assumes ‹⋀b. b ∈ basisB ⟹ norm b = 1›
shows ‹cspan {butterfly a b| (a::'a::{complex_normed_vector}) (b::'b::{chilbert_space,cfinite_dim}). a ∈ basisA ∧ b ∈ basisB} = UNIV›
proof -
have F: ‹∃F∈{butterfly a b |a b. a ∈ basisA ∧ b ∈ basisB}. ∀b'∈basisB. F *⇩V b' = (if b' = b then a else 0)›
if ‹a ∈ basisA› and ‹b ∈ basisB› for a b
apply (rule bexI[where x=‹butterfly a b›])
using assms that by (auto simp: is_ortho_set_def cnorm_eq_1)
show ?thesis
apply (rule cblinfun_cspan_UNIV[where basisA=basisB and basisB=basisA])
using assms apply auto[2]
using F by (smt (verit, ccfv_SIG) image_iff)
qed
lemma cindependent_butterfly:
fixes basisA :: ‹'a::chilbert_space set› and basisB :: ‹'b::chilbert_space set›
assumes ‹is_ortho_set basisA› ‹is_ortho_set basisB›
assumes normA: ‹⋀a. a∈basisA ⟹ norm a = 1› and normB: ‹⋀b. b∈basisB ⟹ norm b = 1›
shows ‹cindependent {butterfly a b| a b. a∈basisA ∧ b∈basisB}›
proof (unfold complex_vector.independent_explicit_module, intro allI impI, rename_tac T f g)
fix T :: ‹('b ⇒⇩C⇩L 'a) set› and f :: ‹'b ⇒⇩C⇩L 'a ⇒ complex› and g :: ‹'b ⇒⇩C⇩L 'a›
assume ‹finite T›
assume T_subset: ‹T ⊆ {butterfly a b |a b. a ∈ basisA ∧ b ∈ basisB}›
define lin where ‹lin = (∑g∈T. f g *⇩C g)›
assume ‹lin = 0›
assume ‹g ∈ T›
then obtain a b where g: ‹g = butterfly a b› and [simp]: ‹a ∈ basisA› ‹b ∈ basisB›
using T_subset by auto
have *: "(vector_to_cblinfun a)* *⇩V f g *⇩C g *⇩V b = 0"
if ‹g ∈ T - {butterfly a b}› for g
proof -
from that
obtain a' b' where g: ‹g = butterfly a' b'› and [simp]: ‹a' ∈ basisA› ‹b' ∈ basisB›
using T_subset by auto
from that have ‹g ≠ butterfly a b› by auto
with g consider (a) ‹a≠a'› | (b) ‹b≠b'›
by auto
then show ‹(vector_to_cblinfun a)* *⇩V f g *⇩C g *⇩V b = 0›
proof cases
case a
then show ?thesis
using ‹is_ortho_set basisA› unfolding g
by (auto simp: is_ortho_set_def butterfly_def scaleC_cblinfun.rep_eq)
next
case b
then show ?thesis
using ‹is_ortho_set basisB› unfolding g
by (auto simp: is_ortho_set_def butterfly_def scaleC_cblinfun.rep_eq)
qed
qed
have ‹0 = (vector_to_cblinfun a)* *⇩V lin *⇩V b›
using ‹lin = 0› by auto
also have ‹… = (∑g∈T. (vector_to_cblinfun a)* *⇩V (f g *⇩C g) *⇩V b)›
unfolding lin_def
apply (rule complex_vector.linear_sum)
by (smt (z3) cblinfun.scaleC_left cblinfun.scaleC_right cblinfun.add_right clinearI plus_cblinfun.rep_eq)
also have ‹… = (∑g∈{butterfly a b}. (vector_to_cblinfun a)* *⇩V (f g *⇩C g) *⇩V b)›
apply (rule sum.mono_neutral_right)
using ‹finite T› * ‹g ∈ T› g by auto
also have ‹… = (vector_to_cblinfun a)* *⇩V (f g *⇩C g) *⇩V b›
by (simp add: g)
also have ‹… = f g›
unfolding g
using normA normB by (auto simp: butterfly_def scaleC_cblinfun.rep_eq cnorm_eq_1)
finally show ‹f g = 0›
by simp
qed
lemma clinear_eq_butterflyI:
fixes F G :: ‹('a::{chilbert_space,cfinite_dim} ⇒⇩C⇩L 'b::complex_inner) ⇒ 'c::complex_vector›
assumes "clinear F" and "clinear G"
assumes ‹cspan basisA = UNIV› ‹cspan basisB = UNIV›
assumes ‹is_ortho_set basisA› ‹is_ortho_set basisB›
assumes "⋀a b. a∈basisA ⟹ b∈basisB ⟹ F (butterfly a b) = G (butterfly a b)"
assumes ‹⋀b. b∈basisB ⟹ norm b = 1›
shows "F = G"
apply (rule complex_vector.linear_eq_on_span[where f=F, THEN ext, rotated 3])
apply (subst cspan_butterfly_UNIV)
using assms by auto
subsection ‹Bifunctionals›
lift_definition bifunctional :: ‹'a::complex_normed_vector ⇒⇩C⇩L (('a ⇒⇩C⇩L complex) ⇒⇩C⇩L complex)›
is ‹λx f. f *⇩V x›
by (simp add: cblinfun.flip)
lemma bifunctional_apply[simp]: ‹(bifunctional *⇩V x) *⇩V f = f *⇩V x›
by (transfer fixing: x f, simp)
lemma bifunctional_isometric[simp]: ‹norm (bifunctional *⇩V x) = norm x› for x :: ‹'a::complex_inner›
proof -
define f :: ‹'a ⇒⇩C⇩L complex› where ‹f = CBlinfun (λy. cinner x y)›
then have [simp]: ‹f *⇩V y = cinner x y› for y
by (simp add: bounded_clinear_CBlinfun_apply bounded_clinear_cinner_right)
then have [simp]: ‹norm f = norm x›
apply (auto intro!: norm_cblinfun_eqI[where x=x] simp: power2_norm_eq_cinner[symmetric])
apply (smt (verit, best) norm_eq_sqrt_cinner norm_ge_zero power2_norm_eq_cinner real_div_sqrt)
using Cauchy_Schwarz_ineq2 by blast
show ?thesis
apply (auto intro!: norm_cblinfun_eqI[where x=f])
apply (metis norm_eq_sqrt_cinner norm_imp_pos_and_ge real_div_sqrt)
by (metis norm_cblinfun ordered_field_class.sign_simps(33))
qed
lemma norm_bifunctional[simp]: ‹norm (bifunctional :: 'a::{complex_inner, not_singleton} ⇒⇩C⇩L _) = 1›
proof -
obtain x :: 'a where [simp]: ‹norm x = 1›
by (meson UNIV_not_singleton ex_norm1)
show ?thesis
by (auto intro!: norm_cblinfun_eqI[where x=x])
qed
subsection ‹Banach-Steinhaus›
theorem cbanach_steinhaus:
fixes F :: ‹'c ⇒ 'a::cbanach ⇒⇩C⇩L 'b::complex_normed_vector›
assumes ‹⋀x. ∃M. ∀n. norm ((F n) *⇩V x) ≤ M›
shows ‹∃M. ∀ n. norm (F n) ≤ M›
using cblinfun_blinfun_transfer[transfer_rule] apply (rule TrueI)?
proof (use assms in transfer)
fix F :: ‹'c ⇒ 'a ⇒⇩L 'b› assume ‹(⋀x. ∃M. ∀n. norm (F n *⇩v x) ≤ M)›
hence ‹⋀x. bounded (range (λn. blinfun_apply (F n) x))›
by (metis (no_types, lifting) boundedI rangeE)
hence ‹bounded (range F)›
by (simp add: banach_steinhaus)
thus ‹∃M. ∀n. norm (F n) ≤ M›
by (simp add: bounded_iff)
qed
subsection ‹Riesz-representation theorem›
theorem riesz_frechet_representation_cblinfun_existence:
fixes f::‹'a::chilbert_space ⇒⇩C⇩L complex›
shows ‹∃t. ∀x. f *⇩V x = ⟨t, x⟩›
apply transfer by (rule riesz_frechet_representation_existence)
lemma riesz_frechet_representation_cblinfun_unique:
fixes f::‹'a::complex_inner ⇒⇩C⇩L complex›
assumes ‹⋀x. f *⇩V x = ⟨t, x⟩›
assumes ‹⋀x. f *⇩V x = ⟨u, x⟩›
shows ‹t = u›
using assms by (rule riesz_frechet_representation_unique)
theorem riesz_frechet_representation_cblinfun_norm:
includes notation_norm
fixes f::‹'a::chilbert_space ⇒⇩C⇩L complex›
assumes ‹⋀x. f *⇩V x = ⟨t, x⟩›
shows ‹∥f∥ = ∥t∥›
using assms
proof transfer
fix f::‹'a ⇒ complex› and t
assume ‹bounded_clinear f› and ‹⋀x. f x = ⟨t, x⟩›
from ‹⋀x. f x = ⟨t, x⟩›
have ‹(norm (f x)) / (norm x) ≤ norm t›
for x
proof(cases ‹norm x = 0›)
case True
thus ?thesis by simp
next
case False
have ‹norm (f x) = norm (⟨t, x⟩)›
using ‹⋀x. f x = ⟨t, x⟩› by simp
also have ‹norm ⟨t, x⟩ ≤ norm t * norm x›
by (simp add: complex_inner_class.Cauchy_Schwarz_ineq2)
finally have ‹norm (f x) ≤ norm t * norm x›
by blast
thus ?thesis
by (metis False linordered_field_class.divide_right_mono nonzero_mult_div_cancel_right norm_ge_zero)
qed
moreover have ‹(norm (f t)) / (norm t) = norm t›
proof(cases ‹norm t = 0›)
case True
thus ?thesis
by simp
next
case False
have ‹f t = ⟨t, t⟩›
using ‹⋀x. f x = ⟨t, x⟩› by blast
also have ‹… = (norm t)^2›
by (meson cnorm_eq_square)
also have ‹… = (norm t)*(norm t)›
by (simp add: power2_eq_square)
finally have ‹f t = (norm t)*(norm t)›
by blast
thus ?thesis
by (metis False Re_complex_of_real ‹⋀x. f x = cinner t x› cinner_ge_zero complex_of_real_cmod nonzero_divide_eq_eq)
qed
ultimately have ‹Sup {(norm (f x)) / (norm x)| x. True} = norm t›
by (smt cSup_eq_maximum mem_Collect_eq)
moreover have ‹Sup {(norm (f x)) / (norm x)| x. True} = (SUP x. (norm (f x)) / (norm x))›
by (simp add: full_SetCompr_eq)
ultimately show ‹onorm f = norm t›
by (simp add: onorm_def)
qed
subsection ‹Extension of complex bounded operators›
definition cblinfun_extension where
"cblinfun_extension S φ = (SOME B. ∀x∈S. B *⇩V x = φ x)"
definition cblinfun_extension_exists where
"cblinfun_extension_exists S φ = (∃B. ∀x∈S. B *⇩V x = φ x)"
lemma cblinfun_extension_existsI:
assumes "⋀x. x∈S ⟹ B *⇩V x = φ x"
shows "cblinfun_extension_exists S φ"
using assms cblinfun_extension_exists_def by blast
lemma cblinfun_extension_exists_finite_dim:
fixes φ::"'a::{complex_normed_vector,cfinite_dim} ⇒ 'b::complex_normed_vector"
assumes "cindependent S"
and "cspan S = UNIV"
shows "cblinfun_extension_exists S φ"
proof-
define f::"'a ⇒ 'b"
where "f = complex_vector.construct S φ"
have "clinear f"
by (simp add: complex_vector.linear_construct assms linear_construct f_def)
have "bounded_clinear f"
using ‹clinear f› assms by auto
then obtain B::"'a ⇒⇩C⇩L 'b"
where "B *⇩V x = f x" for x
using cblinfun_apply_cases by blast
have "B *⇩V x = φ x"
if c1: "x∈S"
for x
proof-
have "B *⇩V x = f x"
by (simp add: ‹⋀x. B *⇩V x = f x›)
also have "… = φ x"
using assms complex_vector.construct_basis f_def that
by (simp add: complex_vector.construct_basis)
finally show?thesis by blast
qed
thus ?thesis
unfolding cblinfun_extension_exists_def
by blast
qed
lemma cblinfun_extension_exists_bounded_dense:
fixes f :: ‹'a::complex_normed_vector ⇒ 'b::cbanach›
assumes ‹csubspace S›
assumes ‹closure S = UNIV›
assumes f_add: ‹⋀x y. x ∈ S ⟹ y ∈ S ⟹ f (x + y) = f x + f y›
assumes f_scale: ‹⋀c x y. x ∈ S ⟹ f (c *⇩C x) = c *⇩C f x›
assumes bounded: ‹⋀x. x ∈ S ⟹ norm (f x) ≤ B * norm x›
shows ‹cblinfun_extension_exists S f›
proof -
obtain B where bounded: ‹⋀x. x ∈ S ⟹ norm (f x) ≤ B * norm x› and ‹B > 0›
using bounded by (smt (z3) mult_mono norm_ge_zero)
have ‹∃xi. (xi ⇢ x) ∧ (∀i. xi i ∈ S)› for x
using assms(2) closure_sequential by blast
then obtain seq :: ‹'a ⇒ nat ⇒ 'a› where seq_lim: ‹seq x ⇢ x› and seq_S: ‹seq x i ∈ S› for x i
apply (atomize_elim, subst all_conj_distrib[symmetric])
apply (rule choice)
by auto
define g where ‹g x = lim (λi. f (seq x i))› for x
have ‹Cauchy (λi. f (seq x i))› for x
proof (rule CauchyI)
fix e :: real assume ‹e > 0›
have ‹Cauchy (seq x)›
using LIMSEQ_imp_Cauchy seq_lim by blast
then obtain M where less_eB: ‹norm (seq x m - seq x n) < e/B› if ‹n ≥ M› and ‹m ≥ M› for n m
apply atomize_elim by (meson CauchyD ‹0 < B› ‹0 < e› linordered_field_class.divide_pos_pos)
have ‹norm (f (seq x m) - f (seq x n)) < e› if ‹n ≥ M› and ‹m ≥ M› for n m
proof -
have ‹norm (f (seq x m) - f (seq x n)) = norm (f (seq x m - seq x n))›
using f_add f_scale seq_S
by (metis add_diff_cancel assms(1) complex_vector.subspace_diff diff_add_cancel)
also have ‹… ≤ B * norm (seq x m - seq x n)›
apply (rule bounded)
by (simp add: assms(1) complex_vector.subspace_diff seq_S)
also from less_eB have ‹… < B * (e/B)›
by (meson ‹0 < B› linordered_semiring_strict_class.mult_strict_left_mono that)
also have ‹… ≤ e›
using ‹0 < B› by auto
finally show ?thesis
by -
qed
then show ‹∃M. ∀m≥M. ∀n≥M. norm (f (seq x m) - f (seq x n)) < e›
by auto
qed
then have f_seq_lim: ‹(λi. f (seq x i)) ⇢ g x› for x
by (simp add: Cauchy_convergent_iff convergent_LIMSEQ_iff g_def)
have f_xi_lim: ‹(λi. f (xi i)) ⇢ g x› if ‹xi ⇢ x› and ‹⋀i. xi i ∈ S› for xi x
proof -
from seq_lim that
have ‹(λi. B * norm (xi i - seq x i)) ⇢ 0›
by (metis (no_types) ‹0 < B› cancel_comm_monoid_add_class.diff_cancel norm_not_less_zero norm_zero tendsto_diff tendsto_norm_zero_iff tendsto_zero_mult_left_iff)
then have ‹(λi. f (xi i + (-1) *⇩C seq x i)) ⇢ 0›
apply (rule Lim_null_comparison[rotated])
using bounded by (simp add: assms(1) complex_vector.subspace_diff seq_S that(2))
then have ‹(λi. f (xi i) - f (seq x i)) ⇢ 0›
apply (subst (asm) f_add)
apply (auto simp: that ‹csubspace S› complex_vector.subspace_neg seq_S)[2]
apply (subst (asm) f_scale)
by (auto simp: that ‹csubspace S› complex_vector.subspace_neg seq_S)
then show ‹(λi. f (xi i)) ⇢ g x›
using Lim_transform f_seq_lim by fastforce
qed
have g_add: ‹g (x + y) = g x + g y› for x y
proof -
obtain xi :: ‹nat ⇒ 'a› where ‹xi ⇢ x› and ‹xi i ∈ S› for i
using seq_S seq_lim by auto
obtain yi :: ‹nat ⇒ 'a› where ‹yi ⇢ y› and ‹yi i ∈ S› for i
using seq_S seq_lim by auto
have ‹(λi. xi i + yi i) ⇢ x + y›
using ‹xi ⇢ x› ‹yi ⇢ y› tendsto_add by blast
then have lim1: ‹(λi. f (xi i + yi i)) ⇢ g (x + y)›
by (simp add: ‹⋀i. xi i ∈ S› ‹⋀i. yi i ∈ S› assms(1) complex_vector.subspace_add f_xi_lim)
have ‹(λi. f (xi i + yi i)) = (λi. f (xi i) + f (yi i))›
by (simp add: ‹⋀i. xi i ∈ S› ‹⋀i. yi i ∈ S› f_add)
also have ‹… ⇢ g x + g y›
by (simp add: ‹⋀i. xi i ∈ S› ‹⋀i. yi i ∈ S› ‹xi ⇢ x› ‹yi ⇢ y› f_xi_lim tendsto_add)
finally show ?thesis
using lim1 LIMSEQ_unique by blast
qed
have g_scale: ‹g (c *⇩C x) = c *⇩C g x› for c x
proof -
obtain xi :: ‹nat ⇒ 'a› where ‹xi ⇢ x› and ‹xi i ∈ S› for i
using seq_S seq_lim by auto
have ‹(λi. c *⇩C xi i) ⇢ c *⇩C x›
using ‹xi ⇢ x› bounded_clinear_scaleC_right clinear_continuous_at isCont_tendsto_compose by blast
then have lim1: ‹(λi. f (c *⇩C xi i)) ⇢ g (c *⇩C x)›
by (simp add: ‹⋀i. xi i ∈ S› assms(1) complex_vector.subspace_scale f_xi_lim)
have ‹(λi. f (c *⇩C xi i)) = (λi. c *⇩C f (xi i))›
by (simp add: ‹⋀i. xi i ∈ S› f_scale)
also have ‹… ⇢ c *⇩C g x›
using ‹⋀i. xi i ∈ S› ‹xi ⇢ x› bounded_clinear_scaleC_right clinear_continuous_at f_xi_lim isCont_tendsto_compose by blast
finally show ?thesis
using lim1 LIMSEQ_unique by blast
qed
have [simp]: ‹f x = g x› if ‹x ∈ S› for x
proof -
have ‹(λ_. x) ⇢ x›
by auto
then have ‹(λ_. f x) ⇢ g x›
using that by (rule f_xi_lim)
then show ‹f x = g x›
by (simp add: LIMSEQ_const_iff)
qed
have g_bounded: ‹norm (g x) ≤ B * norm x› for x
proof -
obtain xi :: ‹nat ⇒ 'a› where ‹xi ⇢ x› and ‹xi i ∈ S› for i
using seq_S seq_lim by auto
then have ‹(λi. f (xi i)) ⇢ g x›
using f_xi_lim by presburger
then have ‹(λi. norm (f (xi i))) ⇢ norm (g x)›
by (metis tendsto_norm)
moreover have ‹(λi. B * norm (xi i)) ⇢ B * norm x›
by (simp add: ‹xi ⇢ x› tendsto_mult_left tendsto_norm)
ultimately show ‹norm (g x) ≤ B * norm x›
apply (rule lim_mono[rotated])
using bounded using ‹xi _ ∈ S› by blast
qed
have ‹bounded_clinear g›
using g_add g_scale apply (rule bounded_clinearI[where K=B])
using g_bounded by (simp add: ordered_field_class.sign_simps(5))
then have [simp]: ‹CBlinfun g *⇩V x = g x› for x
by (subst CBlinfun_inverse, auto)
show ‹cblinfun_extension_exists S f›
apply (rule cblinfun_extension_existsI[where B=‹CBlinfun g›])
by auto
qed
lemma cblinfun_extension_apply:
assumes "cblinfun_extension_exists S f"
and "v ∈ S"
shows "(cblinfun_extension S f) *⇩V v = f v"
by (smt assms cblinfun_extension_def cblinfun_extension_exists_def tfl_some)
subsection ‹Notation›
bundle cblinfun_notation begin
notation cblinfun_compose (infixl "o⇩C⇩L" 55)
notation cblinfun_apply (infixr "*⇩V" 70)
notation cblinfun_image (infixr "*⇩S" 70)
notation adj ("_*" [99] 100)
end
bundle no_cblinfun_notation begin
no_notation cblinfun_compose (infixl "o⇩C⇩L" 55)
no_notation cblinfun_apply (infixr "*⇩V" 70)
no_notation cblinfun_image (infixr "*⇩S" 70)
no_notation adj ("_*" [99] 100)
end
bundle blinfun_notation begin
notation blinfun_apply (infixr "*⇩V" 70)
end
bundle no_blinfun_notation begin
no_notation blinfun_apply (infixr "*⇩V" 70)
end
unbundle no_cblinfun_notation
end
Theory Complex_L2
section ‹‹Complex_L2› -- Hilbert space of square-summable functions›
theory Complex_L2
imports
Complex_Bounded_Linear_Function
"HOL-Analysis.L2_Norm"
"HOL-Library.Rewrite"
"HOL-Analysis.Infinite_Set_Sum"
"Complex_Bounded_Operators.Extra_Infinite_Set_Sum"
begin
unbundle cblinfun_notation
unbundle no_notation_blinfun_apply
subsection ‹l2 norm of functions›
definition "has_ell2_norm x = bdd_above (sum (λi. (cmod (x i))⇧2) ` Collect finite)"
lemma has_ell2_norm_infsetsum: "has_ell2_norm x ⟷ (λi. (cmod (x i))⇧2) abs_summable_on UNIV"
proof
define f where "f i = (cmod (x i))⇧2" for i
assume fsums: "f abs_summable_on UNIV"
define bound where "bound = infsetsum f UNIV"
have "sum f F ≤ bound" if "finite F" for F
proof -
have "sum f F = infsetsum f F"
using that by (rule infsetsum_finite[symmetric])
also have "infsetsum f F ≤ infsetsum f UNIV"
proof (rule infsetsum_mono_neutral_left)
show "f abs_summable_on F"
by (simp add: that)
show "f abs_summable_on UNIV"
by (simp add: fsums)
show "f x ≤ f x"
if "x ∈ F"
for x :: 'a
using that
by simp
show "F ⊆ UNIV"
by simp
show "0 ≤ f x"
if "x ∈ UNIV - F"
for x :: 'a
using that f_def by auto
qed
finally show ?thesis
unfolding bound_def by assumption
qed
thus "has_ell2_norm x"
unfolding has_ell2_norm_def f_def
by (rule bdd_aboveI2[where M=bound], simp)
next
have x1: "∃B. ∀F. finite F ⟶ (∑s∈F. (cmod (x s))⇧2) < B"
if "⋀t. finite t ⟹ (∑i∈t. (cmod (x i))⇧2) ≤ M"
for M
using that by (meson gt_ex le_less_trans)
assume "has_ell2_norm x"
then obtain B where "(∑xa∈F. norm ((cmod (x xa))⇧2)) < B" if "finite F" for F
proof atomize_elim
show "∃B. ∀F. finite F ⟶ (∑xa∈F. norm ((cmod (x xa))⇧2)) < B"
if "has_ell2_norm x"
using that x1
unfolding has_ell2_norm_def unfolding bdd_above_def
by auto
qed
thus "(λi. (cmod (x i))⇧2) abs_summable_on UNIV"
proof (rule_tac abs_summable_finiteI [where B = B])
show "(∑t∈F. norm ((cmod (x t))⇧2)) ≤ B"
if "⋀F. finite F ⟹ (∑s∈F. norm ((cmod (x s))⇧2)) < B"
and "finite F" and "F ⊆ UNIV"
for F :: "'a set"
using that by fastforce
qed
qed
lemma has_ell2_norm_L2_set: "has_ell2_norm x = bdd_above (L2_set (norm o x) ` Collect finite)"
proof-
have bdd_above_image_mono': "bdd_above (f`A)"
if "⋀x y. x≤y ⟹ x:A ⟹ y:A ⟹ f x ≤ f y"
and "∃M∈A. ∀x ∈ A. x ≤ M"
for f::"'a set⇒real" and A
using that
unfolding bdd_above_def by auto
have t3: "bdd_above X ⟹ bdd_above (sqrt ` X)" for X
by (meson bdd_aboveI2 bdd_above_def real_sqrt_le_iff)
moreover have t2: "bdd_above X" if bdd_sqrt: "bdd_above (sqrt ` X)" for X
proof-
obtain y where y:"y ≥ sqrt x" if "x:X" for x
using bdd_sqrt unfolding bdd_above_def by auto
have "y*y ≥ x" if "x:X" for x
by (metis power2_eq_square sqrt_le_D that y)
thus "bdd_above X"
unfolding bdd_above_def by auto
qed
ultimately have bdd_sqrt: "bdd_above X ⟷ bdd_above (sqrt ` X)" for X
by rule
have t1: "bdd_above (sum (λi. (cmod (x i))⇧2) ` Collect finite) =
bdd_above ((λA. sqrt (∑i∈A. ((cmod ∘ x) i)⇧2)) ` Collect finite)"
proof (rewrite asm_rl [of "(λA. sqrt (sum (λi. ((cmod ∘ x) i)⇧2) A)) ` Collect finite
= sqrt ` (λA. (∑i∈A. (cmod (x i))⇧2)) ` Collect finite"])
show "(λA. sqrt (∑i∈A. ((cmod ∘ x) i)⇧2)) ` Collect finite = sqrt ` sum (λi. (cmod (x i))⇧2) ` Collect finite"
by auto
show "bdd_above (sum (λi. (cmod (x i))⇧2) ` Collect finite) = bdd_above (sqrt ` sum (λi. (cmod (x i))⇧2) ` Collect finite)"
by (meson t2 t3)
qed
show "has_ell2_norm x ⟷ bdd_above (L2_set (norm o x) ` Collect finite)"
unfolding has_ell2_norm_def L2_set_def
using t1.
qed
definition "ell2_norm x = sqrt (SUP F∈{F. finite F}. sum (λi. norm (x i)^2) F)" for x :: ‹'a ⇒ complex›
lemma ell2_norm_L2_set:
assumes "has_ell2_norm x"
shows "ell2_norm x = (SUP F∈{F. finite F}. L2_set (norm o x) F)"
proof-
have "sqrt (⨆ (sum (λi. (cmod (x i))⇧2) ` Collect finite)) =
(SUP F∈{F. finite F}. sqrt (∑i∈F. (cmod (x i))⇧2))"
proof (subst continuous_at_Sup_mono)
show "mono sqrt"
by (simp add: mono_def)
show "continuous (at_left (⨆ (sum (λi. (cmod (x i))⇧2) ` Collect finite))) sqrt"
using continuous_at_split isCont_real_sqrt by blast
show "sum (λi. (cmod (x i))⇧2) ` Collect finite ≠ {}"
by auto
show "bdd_above (sum (λi. (cmod (x i))⇧2) ` Collect finite)"
by (metis assms has_ell2_norm_def)
show "⨆ (sqrt ` sum (λi. (cmod (x i))⇧2) ` Collect finite) = (SUP F∈Collect finite. sqrt (∑i∈F. (cmod (x i))⇧2))"
by (metis image_image)
qed
thus ?thesis
unfolding ell2_norm_def L2_set_def o_def.
qed
lemma ell2_norm_infsetsum:
assumes "has_ell2_norm x"
shows "ell2_norm x = sqrt (infsetsum (λi. (norm(x i))^2) UNIV)"
proof-
have "ell2_norm x = sqrt (∑⇩ai. (cmod (x i))⇧2)"
proof (subst infsetsum_nonneg_is_SUPREMUM)
show "(λi. (cmod (x i))⇧2) abs_summable_on UNIV"
using assms has_ell2_norm_infsetsum by fastforce
show "0 ≤ (cmod (x t))⇧2"
if "t ∈ UNIV"
for t :: 'a
using that
by simp
show "ell2_norm x = sqrt (⨆ (sum (λi. (cmod (x i))⇧2) ` {F. finite F ∧ F ⊆ UNIV}))"
unfolding ell2_norm_def by auto
qed
thus ?thesis
by auto
qed
lemma has_ell2_norm_finite[simp]: "has_ell2_norm (x::'a::finite⇒_)"
unfolding has_ell2_norm_def by simp
lemma ell2_norm_finite:
"ell2_norm (x::'a::finite⇒complex) = sqrt (sum (λi. (norm(x i))^2) UNIV)"
proof-
have "(∑i∈t. (cmod (x i))⇧2) ≤ (∑i∈y. (cmod (x i))⇧2)"
if "t ⊆ y"
for t y
proof (subst sum_mono2)
show "finite y"
by simp
show "t ⊆ y"
using that.
show "0 ≤ (cmod (x b))⇧2"
if "b ∈ y - t"
for b :: 'a
using that
by simp
show True by blast
qed
hence mono: "mono (sum (λi. (cmod (x i))⇧2))"
unfolding mono_def
by blast
show ?thesis
unfolding ell2_norm_def apply (subst image_of_maximum[where m=UNIV])
using mono by auto
qed
lemma ell2_norm_finite_L2_set: "ell2_norm (x::'a::finite⇒complex) = L2_set (norm o x) UNIV"
proof (subst ell2_norm_L2_set)
show "has_ell2_norm x"
by simp
show "⨆ (L2_set (cmod ∘ x) ` Collect finite) = L2_set (cmod ∘ x) UNIV"
proof (subst image_of_maximum[where m = UNIV])
show "mono (L2_set (cmod ∘ x))"
by (auto simp: mono_def intro!: L2_set_mono2)
show "(x::'a set) ⊆ UNIV"
if "(x::'a set) ∈ Collect finite"
for x :: "'a set"
using that
by simp
show "(UNIV::'a set) ∈ Collect finite"
by simp
show "L2_set (cmod ∘ x) UNIV = L2_set (cmod ∘ x) UNIV"
by simp
qed
qed
lemma ell2_ket:
fixes a
defines ‹f ≡ (λi. if a = i then 1 else 0)›
shows has_ell2_norm_ket: ‹has_ell2_norm f›
and ell2_norm_ket: ‹ell2_norm f = 1›
proof -
have finite_bound: ‹(∑i∈F. (cmod (if a = i then 1 else 0))⇧2) ≤ 1› if ‹finite F› for F
proof -
have "(∑i∈F. (cmod (if a = i then 1 else 0))⇧2) = 0" if "a∉F"
proof (subst sum.cong [where B = F and h = "λ_. 0"])
show "F = F"
by blast
show "(cmod (if a = x then 1 else 0))⇧2 = 0"
if "x ∈ F"
for x :: 'a
using that ‹a ∉ F› by auto
show "(∑_∈F. (0::real)) = 0"
by simp
qed
moreover have "(∑i∈F. (cmod (if a = i then 1 else 0))⇧2) = 1" if "a∈F"
proof -
obtain F0 where "a∉F0" and F_F0: "F=insert a F0"
by (meson ‹a ∈ F› mk_disjoint_insert)
have "(∑i∈insert a F0. (cmod (if a = i then 1 else 0))⇧2) = 1"
proof (subst sum.insert_remove)
show "finite F0"
using F_F0 ‹finite F› by auto
show "(cmod (if a = a then 1 else 0))⇧2 + (∑i∈F0 - {a}. (cmod (if a = i then 1 else 0))⇧2) = 1"
using sum.not_neutral_contains_not_neutral by fastforce
qed
thus "(∑i∈F. (cmod (if a = i then 1 else 0))⇧2) = 1"
unfolding F_F0.
qed
ultimately show "(∑i∈F. (cmod (if a = i then 1 else 0))⇧2) ≤ 1"
unfolding f_def by linarith
qed
show ‹has_ell2_norm f›
using finite_bound
by (auto intro!: bdd_aboveI[where M=1] simp: f_def has_ell2_norm_def)
have ‹(SUP F∈{F. finite F}. sum (λi. norm (f i)^2) F) = 1›
using finite_bound
by (auto intro!: cSup_eq_maximum rev_image_eqI[where x=‹{a}›]
simp: f_def)
then show ‹ell2_norm f = 1›
unfolding ell2_norm_def by simp
qed
lemma ell2_norm_geq0:
assumes ‹has_ell2_norm x›
shows ‹ell2_norm x ≥ 0›
by (smt (verit, ccfv_SIG) assms cSUP_upper2 ell2_norm_def finite.intros(1) has_ell2_norm_def mem_Collect_eq real_sqrt_abs real_sqrt_le_iff sum.empty zero_power2)
lemma ell2_norm_point_bound:
assumes ‹has_ell2_norm x›
shows ‹ell2_norm x ≥ cmod (x i)›
proof -
have ‹(cmod (x i))⇧2 = sum (λi. (cmod (x i))⇧2) {i}›
by auto
also have "… ≤ (⨆ (sum (λi. (cmod (x i))⇧2) ` Collect finite))"
apply (rule cSUP_upper2[where x=‹{i}›])
apply auto by (metis assms has_ell2_norm_def)
also have ‹… = (ell2_norm x)^2›
by (smt (verit, best) SUP_cong calculation ell2_norm_def norm_ge_zero norm_power_ineq real_sqrt_pow2 sum.cong)
finally show ?thesis
by (simp add: assms ell2_norm_geq0)
qed
lemma ell2_norm_0:
assumes "has_ell2_norm x"
shows "(ell2_norm x = 0) = (x = (λ_. 0))"
proof
assume u1: "x = (λ_. 0)"
have u2: "(SUP x::'a set∈Collect finite. (0::real)) = 0"
if "x = (λ_. 0)"
by (metis cSUP_const empty_Collect_eq finite.emptyI)
show "ell2_norm x = 0"
unfolding ell2_norm_def
using u1 u2 by auto
next
assume norm0: "ell2_norm x = 0"
show "x = (λ_. 0)"
proof
fix i
have ‹cmod (x i) ≤ ell2_norm x›
using assms by (rule ell2_norm_point_bound)
also have ‹… = 0›
by (fact norm0)
finally show "x i = 0" by auto
qed
qed
lemma ell2_norm_smult:
assumes "has_ell2_norm x"
shows "has_ell2_norm (λi. c * x i)" and "ell2_norm (λi. c * x i) = cmod c * ell2_norm x"
proof -
have L2_set_mul: "L2_set (cmod ∘ (λi. c * x i)) F = cmod c * L2_set (cmod ∘ x) F" for F
proof-
have "L2_set (cmod ∘ (λi. c * x i)) F = L2_set (λi. (cmod c * (cmod o x) i)) F"
by (metis comp_def norm_mult)
also have "… = cmod c * L2_set (cmod o x) F"
by (metis norm_ge_zero L2_set_right_distrib)
finally show ?thesis .
qed
from assms obtain M where M: "M ≥ L2_set (cmod o x) F" if "finite F" for F
unfolding has_ell2_norm_L2_set bdd_above_def by auto
hence "cmod c * M ≥ L2_set (cmod o (λi. c * x i)) F" if "finite F" for F
unfolding L2_set_mul
by (simp add: ordered_comm_semiring_class.comm_mult_left_mono that)
thus has: "has_ell2_norm (λi. c * x i)"
unfolding has_ell2_norm_L2_set bdd_above_def using L2_set_mul[symmetric] by auto
have "ell2_norm (λi. c * x i) = (SUP F ∈ Collect finite. (L2_set (cmod ∘ (λi. c * x i)) F))"
by (simp add: ell2_norm_L2_set has)
also have "… = (SUP F ∈ Collect finite. (cmod c * L2_set (cmod ∘ x) F))"
using L2_set_mul by auto
also have "… = cmod c * ell2_norm x"
proof (subst ell2_norm_L2_set)
show "has_ell2_norm x"
by (simp add: assms)
show "(SUP F∈Collect finite. cmod c * L2_set (cmod ∘ x) F) = cmod c * ⨆ (L2_set (cmod ∘ x) ` Collect finite)"
proof (subst continuous_at_Sup_mono [where f = "λx. cmod c * x"])
show "mono ((*) (cmod c))"
by (simp add: mono_def ordered_comm_semiring_class.comm_mult_left_mono)
show "continuous (at_left (⨆ (L2_set (cmod ∘ x) ` Collect finite))) ((*) (cmod c))"
proof (rule continuous_mult)
show "continuous (at_left (⨆ (L2_set (cmod ∘ x) ` Collect finite))) (λx. cmod c)"
by simp
show "continuous (at_left (⨆ (L2_set (cmod ∘ x) ` Collect finite))) (λx. x)"
by simp
qed
show "L2_set (cmod ∘ x) ` Collect finite ≠ {}"
by auto
show "bdd_above (L2_set (cmod ∘ x) ` Collect finite)"
by (meson assms has_ell2_norm_L2_set)
show "(SUP F∈Collect finite. cmod c * L2_set (cmod ∘ x) F) = ⨆ ((*) (cmod c) ` L2_set (cmod ∘ x) ` Collect finite)"
by (metis image_image)
qed
qed
finally show "ell2_norm (λi. c * x i) = cmod c * ell2_norm x".
qed
lemma ell2_norm_triangle:
assumes "has_ell2_norm x" and "has_ell2_norm y"
shows "has_ell2_norm (λi. x i + y i)" and "ell2_norm (λi. x i + y i) ≤ ell2_norm x + ell2_norm y"
proof -
have triangle: "L2_set (cmod ∘ (λi. x i + y i)) F ≤ L2_set (cmod ∘ x) F + L2_set (cmod ∘ y) F"
(is "?lhs≤?rhs")
if "finite F" for F
proof -
have "?lhs ≤ L2_set (λi. (cmod o x) i + (cmod o y) i) F"
proof (rule L2_set_mono)
show "(cmod ∘ (λi. x i + y i)) i ≤ (cmod ∘ x) i + (cmod ∘ y) i"
if "i ∈ F"
for i :: 'a
using that norm_triangle_ineq by auto
show "0 ≤ (cmod ∘ (λi. x i + y i)) i"
if "i ∈ F"
for i :: 'a
using that
by simp
qed
also have "… ≤ ?rhs"
by (rule L2_set_triangle_ineq)
finally show ?thesis .
qed
obtain Mx My where Mx: "Mx ≥ L2_set (cmod o x) F" and My: "My ≥ L2_set (cmod o y) F"
if "finite F" for F
using assms unfolding has_ell2_norm_L2_set bdd_above_def by auto
hence MxMy: "Mx + My ≥ L2_set (cmod ∘ x) F + L2_set (cmod ∘ y) F" if "finite F" for F
using that by fastforce
hence bdd_plus: "bdd_above ((λxa. L2_set (cmod ∘ x) xa + L2_set (cmod ∘ y) xa) ` Collect finite)"
unfolding bdd_above_def by auto
from MxMy have MxMy': "Mx + My ≥ L2_set (cmod ∘ (λi. x i + y i)) F" if "finite F" for F
using triangle that by fastforce
thus has: "has_ell2_norm (λi. x i + y i)"
unfolding has_ell2_norm_L2_set bdd_above_def by auto
have SUP_plus: "(SUP x∈A. f x + g x) ≤ (SUP x∈A. f x) + (SUP x∈A. g x)"
if notempty: "A≠{}" and bddf: "bdd_above (f`A)"and bddg: "bdd_above (g`A)"
for f g :: "'a set ⇒ real" and A
proof-
have xleq: "x ≤ (SUP x∈A. f x) + (SUP x∈A. g x)" if x: "x ∈ (λx. f x + g x) ` A" for x
proof -
obtain a where aA: "a:A" and ax: "x = f a + g a"
using x by blast
have fa: "f a ≤ (SUP x∈A. f x)"
by (simp add: bddf aA cSUP_upper)
moreover have "g a ≤ (SUP x∈A. g x)"
by (simp add: bddg aA cSUP_upper)
ultimately have "f a + g a ≤ (SUP x∈A. f x) + (SUP x∈A. g x)" by simp
with ax show ?thesis by simp
qed
have "(λx. f x + g x) ` A ≠ {}"
using notempty by auto
moreover have "x ≤ ⨆ (f ` A) + ⨆ (g ` A)"
if "x ∈ (λx. f x + g x) ` A"
for x :: real
using that
by (simp add: xleq)
ultimately show ?thesis
by (meson bdd_above_def cSup_le_iff)
qed
have a2: "bdd_above (L2_set (cmod ∘ x) ` Collect finite)"
by (meson assms(1) has_ell2_norm_L2_set)
have a3: "bdd_above (L2_set (cmod ∘ y) ` Collect finite)"
by (meson assms(2) has_ell2_norm_L2_set)
have a1: "Collect finite ≠ {}"
by auto
have a4: "⨆ (L2_set (cmod ∘ (λi. x i + y i)) ` Collect finite)
≤ (SUP xa∈Collect finite.
L2_set (cmod ∘ x) xa + L2_set (cmod ∘ y) xa)"
by (metis (mono_tags, lifting) a1 bdd_plus cSUP_mono mem_Collect_eq triangle)
have "∀r. ⨆ (L2_set (cmod ∘ (λa. x a + y a)) ` Collect finite) ≤ r ∨ ¬ (SUP A∈Collect finite. L2_set (cmod ∘ x) A + L2_set (cmod ∘ y) A) ≤ r"
using a4 by linarith
hence "⨆ (L2_set (cmod ∘ (λi. x i + y i)) ` Collect finite)
≤ ⨆ (L2_set (cmod ∘ x) ` Collect finite) +
⨆ (L2_set (cmod ∘ y) ` Collect finite)"
by (metis (no_types) SUP_plus a1 a2 a3)
hence "⨆ (L2_set (cmod ∘ (λi. x i + y i)) ` Collect finite) ≤ ell2_norm x + ell2_norm y"
by (simp add: assms(1) assms(2) ell2_norm_L2_set)
thus "ell2_norm (λi. x i + y i) ≤ ell2_norm x + ell2_norm y"
by (simp add: ell2_norm_L2_set has)
qed
lemma ell2_norm_uminus:
assumes "has_ell2_norm x"
shows ‹has_ell2_norm (λi. - x i)› and ‹ell2_norm (λi. - x i) = ell2_norm x›
using assms by (auto simp: has_ell2_norm_def ell2_norm_def)
subsection ‹The type ‹ell2› of square-summable functions›
typedef 'a ell2 = "{x::'a⇒complex. has_ell2_norm x}"
unfolding has_ell2_norm_def by (rule exI[of _ "λ_.0"], auto)
setup_lifting type_definition_ell2
instantiation ell2 :: (type)complex_vector begin
lift_definition zero_ell2 :: "'a ell2" is "λ_. 0" by (auto simp: has_ell2_norm_def)
lift_definition uminus_ell2 :: "'a ell2 ⇒ 'a ell2" is uminus by (simp add: has_ell2_norm_def)
lift_definition plus_ell2 :: "'a ell2 ⇒ 'a ell2 ⇒ 'a ell2" is "λf g x. f x + g x"
by (rule ell2_norm_triangle)
lift_definition minus_ell2 :: "'a ell2 ⇒ 'a ell2 ⇒ 'a ell2" is "λf g x. f x - g x"
apply (subst add_uminus_conv_diff[symmetric])
apply (rule ell2_norm_triangle)
by (auto simp add: ell2_norm_uminus)
lift_definition scaleR_ell2 :: "real ⇒ 'a ell2 ⇒ 'a ell2" is "λr f x. complex_of_real r * f x"
by (rule ell2_norm_smult)
lift_definition scaleC_ell2 :: "complex ⇒ 'a ell2 ⇒ 'a ell2" is "λc f x. c * f x"
by (rule ell2_norm_smult)
instance
proof
fix a b c :: "'a ell2"
show "((*⇩R) r::'a ell2 ⇒ _) = (*⇩C) (complex_of_real r)" for r
apply (rule ext) apply transfer by auto
show "a + b + c = a + (b + c)"
by (transfer; rule ext; simp)
show "a + b = b + a"
by (transfer; rule ext; simp)
show "0 + a = a"
by (transfer; rule ext; simp)
show "- a + a = 0"
by (transfer; rule ext; simp)
show "a - b = a + - b"
by (transfer; rule ext; simp)
show "r *⇩C (a + b) = r *⇩C a + r *⇩C b" for r
apply (transfer; rule ext)
by (simp add: vector_space_over_itself.scale_right_distrib)
show "(r + r') *⇩C a = r *⇩C a + r' *⇩C a" for r r'
apply (transfer; rule ext)
by (simp add: ring_class.ring_distribs(2))
show "r *⇩C r' *⇩C a = (r * r') *⇩C a" for r r'
by (transfer; rule ext; simp)
show "1 *⇩C a = a"
by (transfer; rule ext; simp)
qed
end
instantiation ell2 :: (type)complex_normed_vector begin
lift_definition norm_ell2 :: "'a ell2 ⇒ real" is ell2_norm .
declare norm_ell2_def[code del]
definition "dist x y = norm (x - y)" for x y::"'a ell2"
definition "sgn x = x /⇩R norm x" for x::"'a ell2"
definition [code del]: "uniformity = (INF e∈{0<..}. principal {(x::'a ell2, y). norm (x - y) < e})"
definition [code del]: "open U = (∀x∈U. ∀⇩F (x', y) in INF e∈{0<..}. principal {(x, y). norm (x - y) < e}. x' = x ⟶ y ∈ U)" for U :: "'a ell2 set"
instance
proof
fix a b :: "'a ell2"
show "dist a b = norm (a - b)"
by (simp add: dist_ell2_def)
show "sgn a = a /⇩R norm a"
by (simp add: sgn_ell2_def)
show "uniformity = (INF e∈{0<..}. principal {(x, y). dist (x::'a ell2) y < e})"
unfolding dist_ell2_def uniformity_ell2_def by simp
show "open U = (∀x∈U. ∀⇩F (x', y) in uniformity. (x'::'a ell2) = x ⟶ y ∈ U)" for U :: "'a ell2 set"
unfolding uniformity_ell2_def open_ell2_def by simp_all
show "(norm a = 0) = (a = 0)"
apply transfer by (fact ell2_norm_0)
show "norm (a + b) ≤ norm a + norm b"
apply transfer by (fact ell2_norm_triangle)
show "norm (r *⇩R (a::'a ell2)) = ¦r¦ * norm a" for r
and a :: "'a ell2"
apply transfer
by (simp add: ell2_norm_smult(2))
show "norm (r *⇩C a) = cmod r * norm a" for r
apply transfer
by (simp add: ell2_norm_smult(2))
qed
end
lemma norm_point_bound_ell2: "norm (Rep_ell2 x i) ≤ norm x"
apply transfer
by (simp add: ell2_norm_point_bound)
lemma ell2_norm_finite_support:
assumes ‹finite S› ‹⋀ i. i ∉ S ⟹ Rep_ell2 x i = 0›
shows ‹norm x = sqrt ((sum (λi. (cmod (Rep_ell2 x i))⇧2)) S)›
proof -
have ‹(sum (λi. (cmod (Rep_ell2 x i))⇧2)) S ≤ (Sup (sum (λi. (cmod (Rep_ell2 x i))⇧2) ` Collect finite))›
proof-
have ‹(sum (λi. (cmod (Rep_ell2 x i))⇧2)) S ∈(sum (λi. (cmod (Rep_ell2 x i))⇧2) ` Collect finite)›
using ‹finite S›
by simp
moreover have ‹bdd_above (sum (λi. (cmod (Rep_ell2 x i))⇧2) ` Collect finite)›
using Rep_ell2 unfolding has_ell2_norm_def
by auto
ultimately show ?thesis using cSup_upper by simp
qed
moreover have ‹(Sup (sum (λi. (cmod (Rep_ell2 x i))⇧2) ` Collect finite)) ≤ (sum (λi. (cmod (Rep_ell2 x i))⇧2)) S›
proof-
have ‹t ∈ (sum (λi. (cmod (Rep_ell2 x i))⇧2) ` Collect finite) ⟹ t ≤ (sum (λi. (cmod (Rep_ell2 x i))⇧2)) S›
for t
proof-
assume ‹t ∈ (sum (λi. (cmod (Rep_ell2 x i))⇧2) ` Collect finite)›
hence ‹∃ R ∈ (Collect finite). t = (sum (λi. (cmod (Rep_ell2 x i))⇧2)) R›
by blast
then obtain R where ‹R ∈ (Collect finite)› and ‹t = (sum (λi. (cmod (Rep_ell2 x i))⇧2)) R›
by blast
from ‹R ∈ (Collect finite)›
have ‹finite R›
by blast
have ‹R = (R - S) ∪ (R ∩ S)›
by (simp add: Un_Diff_Int)
moreover have ‹(R - S) ∩ (R ∩ S) = {}›
by auto
ultimately have ‹t = (sum (λi. (cmod (Rep_ell2 x i))⇧2)) (R - S)
+ (sum (λi. (cmod (Rep_ell2 x i))⇧2)) (R ∩ S)›
using ‹t = (sum (λi. (cmod (Rep_ell2 x i))⇧2)) R› and ‹finite R›
by (smt sum.Int_Diff)
moreover have ‹(sum (λi. (cmod (Rep_ell2 x i))⇧2)) (R - S) = 0›
proof-
have ‹r ∈ R - S ⟹ (λi. (cmod (Rep_ell2 x i))⇧2) r = 0›
for r
by (simp add: assms(2))
thus ?thesis
by simp
qed
ultimately have ‹t = (sum (λi. (cmod (Rep_ell2 x i))⇧2)) (R ∩ S)›
by simp
moreover have ‹(sum (λi. (cmod (Rep_ell2 x i))⇧2)) (R ∩ S) ≤ (sum (λi. (cmod (Rep_ell2 x i))⇧2)) S›
proof-
have ‹R ∩ S ⊆ S›
by simp
moreover have ‹(λi. (cmod (Rep_ell2 x i))⇧2) i ≥ 0›
for i
by auto
ultimately show ?thesis
by (simp add: assms(1) sum_mono2)
qed
ultimately show ‹t ≤ (sum (λi. (cmod (Rep_ell2 x i))⇧2)) S› by simp
qed
moreover have ‹(sum (λi. (cmod (Rep_ell2 x i))⇧2) ` Collect finite) ≠ {}›
by auto
ultimately show ?thesis
by (simp add: cSup_least)
qed
ultimately have ‹(Sup (sum (λi. (cmod (Rep_ell2 x i))⇧2) ` Collect finite)) = (sum (λi. (cmod (Rep_ell2 x i))⇧2)) S›
by simp
thus ?thesis
by (metis ell2_norm_def norm_ell2.rep_eq)
qed
instantiation ell2 :: (type) complex_inner begin
lift_definition cinner_ell2 :: "'a ell2 ⇒ 'a ell2 ⇒ complex" is
"λx y. infsetsum (λi. (cnj (x i) * y i)) UNIV" .
declare cinner_ell2_def[code del]
instance
proof standard
fix x y z :: "'a ell2" fix c :: complex
show "cinner x y = cnj (cinner y x)"
proof transfer
fix x y :: "'a⇒complex" assume "has_ell2_norm x" and "has_ell2_norm y"
have "(∑⇩ai. cnj (x i) * y i) = (∑⇩ai. cnj (cnj (y i) * x i))"
by (metis complex_cnj_cnj complex_cnj_mult mult.commute)
also have "… = cnj (∑⇩ai. cnj (y i) * x i)"
by (metis infsetsum_cnj)
finally show "(∑⇩ai. cnj (x i) * y i) = cnj (∑⇩ai. cnj (y i) * x i)" .
qed
show "cinner (x + y) z = cinner x z + cinner y z"
proof transfer
fix x y z :: "'a ⇒ complex"
assume "has_ell2_norm x"
hence cnj_x: "(λi. cnj (x i) * cnj (x i)) abs_summable_on UNIV"
by (simp del: complex_cnj_mult add: norm_mult[symmetric] complex_cnj_mult[symmetric] has_ell2_norm_infsetsum power2_eq_square)
assume "has_ell2_norm y"
hence cnj_y: "(λi. cnj (y i) * cnj (y i)) abs_summable_on UNIV"
by (simp del: complex_cnj_mult add: norm_mult[symmetric] complex_cnj_mult[symmetric] has_ell2_norm_infsetsum power2_eq_square)
assume "has_ell2_norm z"
hence z: "(λi. z i * z i) abs_summable_on UNIV"
by (simp add: norm_mult[symmetric] has_ell2_norm_infsetsum power2_eq_square)
have cnj_x_z:"(λi. cnj (x i) * z i) abs_summable_on UNIV"
using cnj_x z by (rule abs_summable_product)
have cnj_y_z:"(λi. cnj (y i) * z i) abs_summable_on UNIV"
using cnj_y z by (rule abs_summable_product)
show "(∑⇩ai. cnj (x i + y i) * z i) = (∑⇩ai. cnj (x i) * z i) + (∑⇩ai. cnj (y i) * z i)"
proof (subst infsetsum_add [symmetric])
show "(λi. cnj (x i) * z i) abs_summable_on UNIV"
by (simp add: cnj_x_z)
show "(λi. cnj (y i) * z i) abs_summable_on UNIV"
by (simp add: cnj_y_z)
show "(∑⇩ai. cnj (x i + y i) * z i) = (∑⇩ai. cnj (x i) * z i + cnj (y i) * z i)"
by (metis complex_cnj_add distrib_right)
qed
qed
show "cinner (c *⇩C x) y = cnj c * cinner x y"
proof transfer
fix x y :: "'a ⇒ complex" and c :: complex
assume "has_ell2_norm x"
hence cnj_x: "(λi. cnj (x i) * cnj (x i)) abs_summable_on UNIV"
by (simp del: complex_cnj_mult add: norm_mult[symmetric] complex_cnj_mult[symmetric] has_ell2_norm_infsetsum power2_eq_square)
assume "has_ell2_norm y"
hence y: "(λi. y i * y i) abs_summable_on UNIV"
by (simp add: norm_mult[symmetric] has_ell2_norm_infsetsum power2_eq_square)
have cnj_x_y:"(λi. cnj (x i) * y i) abs_summable_on UNIV"
using cnj_x y by (rule abs_summable_product)
thus "(∑⇩ai. cnj (c * x i) * y i) = cnj c * (∑⇩ai. cnj (x i) * y i)"
proof (subst infsetsum_cmult_right [symmetric])
show "(λi. cnj (x i) * y i) abs_summable_on UNIV"
if "(λi. cnj (x i) * y i) abs_summable_on UNIV"
and "cnj c ≠ 0"
using that
by simp
show "(∑⇩ai. cnj (c * x i) * y i) = (∑⇩ai. cnj c * (cnj (x i) * y i))"
if "(λi. cnj (x i) * y i) abs_summable_on UNIV"
using that
by (metis complex_cnj_mult vector_space_over_itself.scale_scale)
qed
qed
show "0 ≤ cinner x x"
proof transfer
fix x :: "'a ⇒ complex"
assume "has_ell2_norm x"
hence "(λi. cmod (cnj (x i) * x i)) abs_summable_on UNIV"
by (simp del: abs_summable_on_norm_iff add: norm_mult has_ell2_norm_infsetsum power2_eq_square)
hence "(λi. cnj (x i) * x i) abs_summable_on UNIV"
by (subst abs_summable_on_norm_iff[symmetric])
hence sum: "(λi. cnj (x i) * x i) abs_summable_on UNIV"
unfolding has_ell2_norm_infsetsum power2_eq_square.
have "0 = (∑⇩ai::'a. 0)" by auto
also have "… ≤ (∑⇩ai. cnj (x i) * x i)"
proof (rule infsetsum_mono_complex)
show "(λi. 0::complex) abs_summable_on (UNIV::'a set)"
by simp
show "(λi. cnj (x i) * x i) abs_summable_on UNIV"
by (simp add: sum)
show "0 ≤ cnj (f x) * f x"
if "x ∈ UNIV"
for x :: 'a and f :: "'a ⇒_"
using that
by simp
qed
finally show "0 ≤ (∑⇩ai. cnj (x i) * x i)" by assumption
qed
show "(cinner x x = 0) = (x = 0)"
proof (transfer, auto)
fix x :: "'a ⇒ complex"
assume "has_ell2_norm x"
hence "(λi::'a. cmod (cnj (x i) * x i)) abs_summable_on UNIV"
unfolding has_ell2_norm_infsetsum power2_eq_square
by (metis (no_types, lifting) abs_summable_on_cong complex_mod_cnj norm_mult)
hence cmod_x2: "(λi. cnj (x i) * x i) abs_summable_on UNIV"
unfolding has_ell2_norm_infsetsum power2_eq_square
by simp
assume eq0: "(∑⇩ai. cnj (x i) * x i) = 0"
show "x = (λ_. 0)"
proof (rule ccontr)
assume "x ≠ (λ_. 0)"
then obtain i where "x i ≠ 0" by auto
hence "0 < cnj (x i) * x i"
by (metis le_less cnj_x_x_geq0 complex_cnj_zero_iff vector_space_over_itself.scale_eq_0_iff)
also have "… = (∑⇩ai∈{i}. cnj (x i) * x i)" by auto
also have "… ≤ (∑⇩ai. cnj (x i) * x i)"
proof (rule infsetsum_subset_complex)
show "(λi. cnj (x i) * x i) abs_summable_on UNIV"
by (simp add: cmod_x2)
show "{i} ⊆ UNIV"
by simp
show "0 ≤ cnj (f x) * f x"
if "x ∉ {i}"
for x :: 'a and f::"'a ⇒ _"
using that
by simp
qed
also from eq0 have "… = 0" by assumption
finally show False by simp
qed
qed
show "norm x = sqrt (cmod (cinner x x))"
proof transfer
fix x :: "'a ⇒ complex"
assume x: "has_ell2_norm x"
have "(λi::'a. cmod (x i) * cmod (x i)) abs_summable_on UNIV ⟹
(λi::'a. cmod (cnj (x i) * x i)) abs_summable_on UNIV"
by (simp del: abs_summable_on_norm_iff add: norm_mult has_ell2_norm_infsetsum power2_eq_square)
hence sum: "(λi. cnj (x i) * x i) abs_summable_on UNIV"
using x
unfolding has_ell2_norm_infsetsum power2_eq_square
by auto
from x have "ell2_norm x = sqrt (∑⇩ai. (cmod (x i))⇧2)"
proof (subst ell2_norm_infsetsum)
show "has_ell2_norm x"
if "has_ell2_norm x"
using that.
show "sqrt (∑⇩ai. (cmod (x i))⇧2) = sqrt (∑⇩ai. (cmod (x i))⇧2)"
if "has_ell2_norm x"
using that
by simp
qed
also have "… = sqrt (∑⇩ai. cmod (cnj (x i) * x i))"
unfolding norm_complex_def power2_eq_square by auto
also have "… = sqrt (cmod (∑⇩ai. cnj (x i) * x i))"
proof (subst infsetsum_cmod)
show "(λi. cnj (x i) * x i) abs_summable_on UNIV"
by (simp add: sum)
show "0 ≤ cnj (f x) * f x"
if "(x::'a) ∈ UNIV"
for x :: 'a and f::"'a ⇒ _"
using that
by simp
show "sqrt (cmod (∑⇩ai. cnj (x i) * x i)) = sqrt (cmod (∑⇩ai. cnj (x i) * x i))"
by simp
qed
finally show "ell2_norm x = sqrt (cmod (∑⇩ai. cnj (x i) * x i))" by assumption
qed
qed
end
instance ell2 :: (type) chilbert_space
proof
fix X :: ‹nat ⇒ 'a ell2›
define x where ‹x n a = Rep_ell2 (X n) a› for n a
have [simp]: ‹has_ell2_norm (x n)› for n
using Rep_ell2 x_def[abs_def] by simp
assume ‹Cauchy X›
moreover have "dist (x n a) (x m a) ≤ dist (X n) (X m)" for n m a
by (metis Rep_ell2 x_def dist_norm ell2_norm_point_bound mem_Collect_eq minus_ell2.rep_eq norm_ell2.rep_eq)
ultimately have ‹Cauchy (λn. x n a)› for a
by (meson Cauchy_def le_less_trans)
then obtain l where x_lim: ‹(λn. x n a) ⇢ l a› for a
apply atomize_elim apply (rule choice)
by (simp add: convergent_eq_Cauchy)
define L where ‹L = Abs_ell2 l›
define normF where ‹normF F x = L2_set (cmod ∘ x) F› for F :: ‹'a set› and x
have normF_triangle: ‹normF F (λa. x a + y a) ≤ normF F x + normF F y› if ‹finite F› for F x y
proof -
have ‹normF F (λa. x a + y a) = L2_set (λa. cmod (x a + y a)) F›
by (metis (mono_tags, lifting) L2_set_cong comp_apply normF_def)
also have ‹… ≤ L2_set (λa. cmod (x a) + cmod (y a)) F›
by (meson L2_set_mono norm_ge_zero norm_triangle_ineq)
also have ‹… ≤ L2_set (λa. cmod (x a)) F + L2_set (λa. cmod (y a)) F›
by (simp add: L2_set_triangle_ineq)
also have ‹… ≤ normF F x + normF F y›
by (smt (verit, best) L2_set_cong normF_def comp_apply)
finally show ?thesis
by -
qed
have normF_negate: ‹normF F (λa. - x a) = normF F x› if ‹finite F› for F x
unfolding normF_def o_def by simp
have normF_ell2norm: ‹normF F x ≤ ell2_norm x› if ‹finite F› and ‹has_ell2_norm x› for F x
apply (auto intro!: cSUP_upper2[where x=F] simp: that normF_def ell2_norm_L2_set)
by (meson has_ell2_norm_L2_set that(2))
note Lim_bounded2[rotated, rule_format, trans]
from ‹Cauchy X›
obtain I where cauchyX: ‹norm (X n - X m) ≤ ε› if ‹ε>0› ‹n≥I ε› ‹m≥I ε› for ε n m
by (metis Cauchy_def dist_norm less_eq_real_def)
have normF_xx: ‹normF F (λa. x n a - x m a) ≤ ε› if ‹finite F› ‹ε>0› ‹n≥I ε› ‹m≥I ε› for ε n m F
apply (subst asm_rl[of ‹(λa. x n a - x m a) = Rep_ell2 (X n - X m)›])
apply (simp add: x_def minus_ell2.rep_eq)
using that cauchyX by (metis Rep_ell2 mem_Collect_eq normF_ell2norm norm_ell2.rep_eq order_trans)
have normF_xl_lim: ‹(λm. normF F (λa. x m a - l a)) ⇢ 0› if ‹finite F› for F
proof -
have ‹(λxa. cmod (x xa m - l m)) ⇢ 0› for m
using x_lim by (simp add: LIM_zero_iff tendsto_norm_zero)
then have ‹(λm. ∑i∈F. ((cmod ∘ (λa. x m a - l a)) i)⇧2) ⇢ 0›
by (auto intro: tendsto_null_sum)
then show ?thesis
unfolding normF_def L2_set_def
using tendsto_real_sqrt by force
qed
have normF_xl: ‹normF F (λa. x n a - l a) ≤ ε›
if ‹n ≥ I ε› and ‹ε > 0› and ‹finite F› for n ε F
proof -
have ‹normF F (λa. x n a - l a) - ε ≤ normF F (λa. x n a - x m a) + normF F (λa. x m a - l a) - ε› for m
using normF_triangle[OF ‹finite F›, where x=‹(λa. x n a - x m a)› and y=‹(λa. x m a - l a)›]
by auto
also have ‹… m ≤ normF F (λa. x m a - l a)› if ‹m ≥ I ε› for m
using normF_xx[OF ‹finite F› ‹ε>0› ‹n ≥ I ε› ‹m ≥ I ε›]
by auto
also have ‹(λm. … m) ⇢ 0›
using ‹finite F› by (rule normF_xl_lim)
finally show ?thesis
by auto
qed
have ‹normF F l ≤ 1 + normF F (x (I 1))› if [simp]: ‹finite F› for F
using normF_xl[where F=F and ε=1 and n=‹I 1›]
using normF_triangle[where F=F and x=‹x (I 1)› and y=‹λa. l a - x (I 1) a›]
using normF_negate[where F=F and x=‹(λa. x (I 1) a - l a)›]
by auto
also have ‹… F ≤ 1 + ell2_norm (x (I 1))› if ‹finite F› for F
using normF_ell2norm that by simp
finally have [simp]: ‹has_ell2_norm l›
unfolding has_ell2_norm_L2_set
by (auto intro!: bdd_aboveI simp flip: normF_def)
then have ‹l = Rep_ell2 L›
by (simp add: Abs_ell2_inverse L_def)
have [simp]: ‹has_ell2_norm (λa. x n a - l a)› for n
apply (subst diff_conv_add_uminus)
apply (rule ell2_norm_triangle)
by (auto intro!: ell2_norm_uminus)
from normF_xl have ell2norm_xl: ‹ell2_norm (λa. x n a - l a) ≤ ε›
if ‹n ≥ I ε› and ‹ε > 0› for n ε
apply (subst ell2_norm_L2_set)
using that by (auto intro!: cSUP_least simp: normF_def)
have ‹norm (X n - L) ≤ ε› if ‹n ≥ I ε› and ‹ε > 0› for n ε
using ell2norm_xl[OF that]
apply (simp add: x_def norm_ell2.rep_eq ‹l = Rep_ell2 L›)
by (smt (verit, best) SUP_cong ell2_norm_def minus_ell2.rep_eq sum.cong)
then have ‹X ⇢ L›
unfolding tendsto_iff
apply (auto simp: dist_norm eventually_sequentially)
by (meson field_lbound_gt_zero le_less_trans)
then show ‹convergent X›
by (rule convergentI)
qed
instantiation ell2 :: (CARD_1) complex_algebra_1
begin
lift_definition one_ell2 :: "'a ell2" is "λ_. 1" by simp
lift_definition times_ell2 :: "'a ell2 ⇒ 'a ell2 ⇒ 'a ell2" is "λa b x. a x * b x"
by simp
instance
proof
fix a b c :: "'a ell2" and r :: complex
show "a * b * c = a * (b * c)"
by (transfer, auto)
show "(a + b) * c = a * c + b * c"
apply (transfer, rule ext)
by (simp add: distrib_left mult.commute)
show "a * (b + c) = a * b + a * c"
apply transfer
by (simp add: ring_class.ring_distribs(1))
show "r *⇩C a * b = r *⇩C (a * b)"
by (transfer, auto)
show "(a::'a ell2) * r *⇩C b = r *⇩C (a * b)"
by (transfer, auto)
show "1 * a = a"
by (transfer, rule ext, auto)
show "a * 1 = a"
by (transfer, rule ext, auto)
show "(0::'a ell2) ≠ 1"
apply transfer
by (meson zero_neq_one)
qed
end
instantiation ell2 :: (CARD_1) field begin
lift_definition divide_ell2 :: "'a ell2 ⇒ 'a ell2 ⇒ 'a ell2" is "λa b x. a x / b x"
by simp
lift_definition inverse_ell2 :: "'a ell2 ⇒ 'a ell2" is "λa x. inverse (a x)"
by simp
instance
proof (intro_classes; transfer)
fix a :: "'a ⇒ complex"
assume "a ≠ (λ_. 0)"
then obtain y where ay: "a y ≠ 0"
by auto
show "(λx. inverse (a x) * a x) = (λ_. 1)"
proof (rule ext)
fix x
have "x = y"
by auto
with ay have "a x ≠ 0"
by metis
then show "inverse (a x) * a x = 1"
by auto
qed
qed (auto simp add: divide_complex_def mult.commute ring_class.ring_distribs)
end
subsection ‹Orthogonality›
lemma ell2_pointwise_ortho:
assumes ‹⋀ i. Rep_ell2 x i = 0 ∨ Rep_ell2 y i = 0›
shows ‹is_orthogonal x y›
using assms apply transfer
by (simp add: infsetsum_all_0)
subsection ‹Truncated vectors›
lift_definition trunc_ell2:: ‹'a set ⇒ 'a ell2 ⇒ 'a ell2›
is ‹λ S x. (λ i. (if i ∈ S then x i else 0))›
unfolding has_ell2_norm_def
apply (rule bdd_above_image_mono)
by (auto intro!: sum_mono)
lemma trunc_ell2_empty[simp]: ‹trunc_ell2 {} x = 0›
apply transfer by simp
lemma norm_id_minus_trunc_ell2:
‹(norm (x - trunc_ell2 S x))^2 = (norm x)^2 - (norm (trunc_ell2 S x))^2›
proof-
have ‹Rep_ell2 (trunc_ell2 S x) i = 0 ∨ Rep_ell2 (x - trunc_ell2 S x) i = 0› for i
apply transfer
by auto
hence ‹⟨ (trunc_ell2 S x), (x - trunc_ell2 S x) ⟩ = 0›
using ell2_pointwise_ortho by blast
hence ‹(norm x)^2 = (norm (trunc_ell2 S x))^2 + (norm (x - trunc_ell2 S x))^2›
using pythagorean_theorem by fastforce
thus ?thesis by simp
qed
lemma norm_trunc_ell2_finite:
‹finite S ⟹ (norm (trunc_ell2 S x)) = sqrt ((sum (λi. (cmod (Rep_ell2 x i))⇧2)) S)›
proof-
assume ‹finite S›
moreover have ‹⋀ i. i ∉ S ⟹ Rep_ell2 ((trunc_ell2 S x)) i = 0›
by (simp add: trunc_ell2.rep_eq)
ultimately have ‹(norm (trunc_ell2 S x)) = sqrt ((sum (λi. (cmod (Rep_ell2 ((trunc_ell2 S x)) i))⇧2)) S)›
using ell2_norm_finite_support
by blast
moreover have ‹⋀ i. i ∈ S ⟹ Rep_ell2 ((trunc_ell2 S x)) i = Rep_ell2 x i›
by (simp add: trunc_ell2.rep_eq)
ultimately show ?thesis by simp
qed
lemma trunc_ell2_lim_at_UNIV:
‹((λS. trunc_ell2 S ψ) ⤏ ψ) (finite_subsets_at_top UNIV)›
proof -
define f where ‹f i = (cmod (Rep_ell2 ψ i))⇧2› for i
have has: ‹has_ell2_norm (Rep_ell2 ψ)›
using Rep_ell2 by blast
then have summable: "f abs_summable_on UNIV"
using f_def has_ell2_norm_infsetsum by fastforce
have ‹norm ψ = (ell2_norm (Rep_ell2 ψ))›
apply transfer by simp
also have ‹… = sqrt (infsetsum' f UNIV)›
unfolding ell2_norm_infsetsum[OF has] f_def[symmetric]
using summable by (simp add: infsetsum_infsetsum')
finally have normψ: ‹norm ψ = sqrt (infsetsum' f UNIV)›
by -
have norm_trunc: ‹norm (trunc_ell2 S ψ) = sqrt (sum f S)› if ‹finite S› for S
using f_def that norm_trunc_ell2_finite by fastforce
have ‹(sum f ⤏ infsetsum' f UNIV) (finite_subsets_at_top UNIV)›
by (simp add: abs_summable_infsetsum'_converges infsetsum'_tendsto summable)
then have ‹((λS. sqrt (sum f S)) ⤏ sqrt (infsetsum' f UNIV)) (finite_subsets_at_top UNIV)›
using tendsto_real_sqrt by blast
then have ‹((λS. norm (trunc_ell2 S ψ)) ⤏ norm ψ) (finite_subsets_at_top UNIV)›
apply (subst tendsto_cong[where g=‹λS. sqrt (sum f S)›])
by (auto simp add: eventually_finite_subsets_at_top_weakI norm_trunc normψ)
then have ‹((λS. (norm (trunc_ell2 S ψ))⇧2) ⤏ (norm ψ)⇧2) (finite_subsets_at_top UNIV)›
by (simp add: tendsto_power)
then have ‹((λS. (norm ψ)⇧2 - (norm (trunc_ell2 S ψ))⇧2) ⤏ 0) (finite_subsets_at_top UNIV)›
apply (rule tendsto_diff[where a=‹(norm ψ)^2› and b=‹(norm ψ)^2›, simplified, rotated])
by auto
then have ‹((λS. (norm (ψ - trunc_ell2 S ψ))⇧2) ⤏ 0) (finite_subsets_at_top UNIV)›
unfolding norm_id_minus_trunc_ell2 by simp
then have ‹((λS. norm (ψ - trunc_ell2 S ψ)) ⤏ 0) (finite_subsets_at_top UNIV)›
by auto
then have ‹((λS. ψ - trunc_ell2 S ψ) ⤏ 0) (finite_subsets_at_top UNIV)›
by (rule tendsto_norm_zero_cancel)
then show ?thesis
apply (rule Lim_transform2[where f=‹λ_. ψ›, rotated])
by simp
qed
subsection ‹Kets and bras›
lift_definition ket :: "'a ⇒ 'a ell2" is "λx y. if x=y then 1 else 0"
by (rule has_ell2_norm_ket)
abbreviation bra :: "'a ⇒ (_,complex) cblinfun" where "bra i ≡ vector_to_cblinfun (ket i)*" for i
instance ell2 :: (type) not_singleton
proof standard
have "ket undefined ≠ (0::'a ell2)"
proof transfer
show "(λy. if (undefined::'a) = y then 1::complex else 0) ≠ (λ_. 0)"
by (meson one_neq_zero)
qed
thus ‹∃x y::'a ell2. x ≠ y›
by blast
qed
lemma cinner_ket_left: ‹⟨ket i, ψ⟩ = Rep_ell2 ψ i›
apply (transfer fixing: i)
apply (subst infsetsum_cong_neutral[where B=‹{i}›])
by auto
lemma cinner_ket_right: ‹⟨ψ, ket i⟩ = cnj (Rep_ell2 ψ i)›
apply (transfer fixing: i)
apply (subst infsetsum_cong_neutral[where B=‹{i}›])
by auto
lemma cinner_ket_eqI:
assumes ‹⋀i. cinner (ket i) ψ = cinner (ket i) φ›
shows ‹ψ = φ›
by (metis Rep_ell2_inject assms cinner_ket_left ext)
lemma norm_ket[simp]: "norm (ket i) = 1"
apply transfer by (rule ell2_norm_ket)
lemma cinner_ket_same[simp]:
‹⟨ket i, ket i⟩ = 1›
proof-
have ‹norm (ket i) = 1›
by simp
hence ‹sqrt (cmod ⟨ket i, ket i⟩) = 1›
by (metis norm_eq_sqrt_cinner)
hence ‹cmod ⟨ket i, ket i⟩ = 1›
using real_sqrt_eq_1_iff by blast
moreover have ‹⟨ket i, ket i⟩ = cmod ⟨ket i, ket i⟩›
proof-
have ‹⟨ket i, ket i⟩ ∈ ℝ›
by (simp add: cinner_real)
thus ?thesis
by (metis cinner_ge_zero complex_of_real_cmod)
qed
ultimately show ?thesis by simp
qed
lemma orthogonal_ket[simp]:
‹is_orthogonal (ket i) (ket j) ⟷ i ≠ j›
by (simp add: cinner_ket_left ket.rep_eq)
lemma cinner_ket: ‹⟨ket i, ket j⟩ = (if i=j then 1 else 0)›
by (simp add: cinner_ket_left ket.rep_eq)
lemma ket_injective[simp]: ‹ket i = ket j ⟷ i = j›
by (metis cinner_ket one_neq_zero)
lemma inj_ket[simp]: ‹inj ket›
by (simp add: inj_on_def)
lemma trunc_ell2_ket_cspan:
‹trunc_ell2 S x ∈ (cspan (range ket))› if ‹finite S›
proof (use that in induction)
case empty
then show ?case
by (auto intro: complex_vector.span_zero)
next
case (insert a F)
from insert.hyps have ‹trunc_ell2 (insert a F) x = trunc_ell2 F x + Rep_ell2 x a *⇩C ket a›
apply (transfer fixing: F a)
by auto
with insert.IH
show ?case
by (simp add: complex_vector.span_add_eq complex_vector.span_base complex_vector.span_scale)
qed
lemma closed_cspan_range_ket[simp]:
‹closure (cspan (range ket)) = UNIV›
proof (intro set_eqI iffI UNIV_I closure_approachable[THEN iffD2] allI impI)
fix ψ :: ‹'a ell2›
fix e :: real assume ‹e > 0›
have ‹((λS. trunc_ell2 S ψ) ⤏ ψ) (finite_subsets_at_top UNIV)›
by (rule trunc_ell2_lim_at_UNIV)
then obtain F where ‹finite F› and ‹dist (trunc_ell2 F ψ) ψ < e›
apply (drule_tac tendstoD[OF _ ‹e > 0›])
by (auto dest: simp: eventually_finite_subsets_at_top)
moreover have ‹trunc_ell2 F ψ ∈ cspan (range ket)›
using ‹finite F› trunc_ell2_ket_cspan by blast
ultimately show ‹∃φ∈cspan (range ket). dist φ ψ < e›
by auto
qed
lemma ccspan_range_ket[simp]: "ccspan (range ket) = (top::('a ell2 ccsubspace))"
proof-
have ‹closure (complex_vector.span (range ket)) = (UNIV::'a ell2 set)›
using Complex_L2.closed_cspan_range_ket by blast
thus ?thesis
by (simp add: ccspan.abs_eq top_ccsubspace.abs_eq)
qed
lemma cspan_range_ket_finite[simp]: "cspan (range ket :: 'a::finite ell2 set) = UNIV"
by (metis closed_cspan_range_ket closure_finite_cspan finite_class.finite_UNIV finite_imageI)
instance ell2 :: (finite) cfinite_dim
proof
define basis :: ‹'a ell2 set› where ‹basis = range ket›
have ‹finite basis›
unfolding basis_def by simp
moreover have ‹cspan basis = UNIV›
by (simp add: basis_def)
ultimately show ‹∃basis::'a ell2 set. finite basis ∧ cspan basis = UNIV›
by auto
qed
instantiation ell2 :: (enum) onb_enum begin
definition "canonical_basis_ell2 = map ket Enum.enum"
instance
proof
show "distinct (canonical_basis::'a ell2 list)"
proof-
have ‹finite (UNIV::'a set)›
by simp
have ‹distinct (enum_class.enum::'a list)›
using enum_distinct by blast
moreover have ‹inj_on ket (set enum_class.enum)›
by (meson inj_onI ket_injective)
ultimately show ?thesis
unfolding canonical_basis_ell2_def
using distinct_map
by blast
qed
show "is_ortho_set (set (canonical_basis::'a ell2 list))"
apply (auto simp: canonical_basis_ell2_def enum_UNIV)
by (smt (z3) norm_ket f_inv_into_f is_ortho_set_def orthogonal_ket norm_zero)
show "cindependent (set (canonical_basis::'a ell2 list))"
apply (auto simp: canonical_basis_ell2_def enum_UNIV)
by (smt (verit, best) norm_ket f_inv_into_f is_ortho_set_def is_ortho_set_cindependent orthogonal_ket norm_zero)
show "cspan (set (canonical_basis::'a ell2 list)) = UNIV"
by (auto simp: canonical_basis_ell2_def enum_UNIV)
show "norm (x::'a ell2) = 1"
if "(x::'a ell2) ∈ set canonical_basis"
for x :: "'a ell2"
using that unfolding canonical_basis_ell2_def
by auto
qed
end
lemma canonical_basis_length_ell2[code_unfold, simp]:
"length (canonical_basis ::'a::enum ell2 list) = CARD('a)"
unfolding canonical_basis_ell2_def apply simp
using card_UNIV_length_enum by metis
lemma ket_canonical_basis: "ket x = canonical_basis ! enum_idx x"
proof-
have "x = (enum_class.enum::'a list) ! enum_idx x"
using enum_idx_correct[where i = x] by simp
hence p1: "ket x = ket ((enum_class.enum::'a list) ! enum_idx x)"
by simp
have "enum_idx x < length (enum_class.enum::'a list)"
using enum_idx_bound[where x = x].
hence "(map ket (enum_class.enum::'a list)) ! enum_idx x
= ket ((enum_class.enum::'a list) ! enum_idx x)"
by auto
thus ?thesis
unfolding canonical_basis_ell2_def using p1 by auto
qed
lemma clinear_equal_ket:
fixes f g :: ‹'a::finite ell2 ⇒ _›
assumes ‹clinear f›
assumes ‹clinear g›
assumes ‹⋀i. f (ket i) = g (ket i)›
shows ‹f = g›
apply (rule ext)
apply (rule complex_vector.linear_eq_on_span[where f=f and g=g and B=‹range ket›])
using assms by auto
lemma equal_ket:
fixes A B :: ‹('a ell2, 'b::complex_normed_vector) cblinfun›
assumes ‹⋀ x. cblinfun_apply A (ket x) = cblinfun_apply B (ket x)›
shows ‹A = B›
apply (rule cblinfun_eq_gen_eqI[where G=‹range ket›])
using assms by auto
lemma antilinear_equal_ket:
fixes f g :: ‹'a::finite ell2 ⇒ _›
assumes ‹antilinear f›
assumes ‹antilinear g›
assumes ‹⋀i. f (ket i) = g (ket i)›
shows ‹f = g›
proof -
have [simp]: ‹clinear (f ∘ from_conjugate_space)›
apply (rule antilinear_o_antilinear)
using assms by (simp_all add: antilinear_from_conjugate_space)
have [simp]: ‹clinear (g ∘ from_conjugate_space)›
apply (rule antilinear_o_antilinear)
using assms by (simp_all add: antilinear_from_conjugate_space)
have [simp]: ‹cspan (to_conjugate_space ` (range ket :: 'a ell2 set)) = UNIV›
by simp
have "f o from_conjugate_space = g o from_conjugate_space"
apply (rule ext)
apply (rule complex_vector.linear_eq_on_span[where f="f o from_conjugate_space" and g="g o from_conjugate_space" and B=‹to_conjugate_space ` range ket›])
apply (simp, simp)
using assms(3) by (auto simp: to_conjugate_space_inverse)
then show "f = g"
by (smt (verit) UNIV_I from_conjugate_space_inverse surj_def surj_fun_eq to_conjugate_space_inject)
qed
lemma cinner_ket_adjointI:
fixes F::"'a ell2 ⇒⇩C⇩L _" and G::"'b ell2 ⇒⇩C⇩L_"
assumes "⋀ i j. ⟨F *⇩V ket i, ket j⟩ = ⟨ket i, G *⇩V ket j⟩"
shows "F = G*"
proof -
from assms
have ‹(F *⇩V x) ∙⇩C y = x ∙⇩C (G *⇩V y)› if ‹x ∈ range ket› and ‹y ∈ range ket› for x y
using that by auto
then have ‹(F *⇩V x) ∙⇩C y = x ∙⇩C (G *⇩V y)› if ‹x ∈ range ket› for x y
apply (rule bounded_clinear_eq_on[where G=‹range ket› and t=y, rotated 2])
using that by (auto intro!: bounded_linear_intros)
then have ‹(F *⇩V x) ∙⇩C y = x ∙⇩C (G *⇩V y)› for x y
apply (rule bounded_antilinear_eq_on[where G=‹range ket› and t=x, rotated 2])
by (auto intro!: bounded_linear_intros)
then show ?thesis
by (rule adjoint_eqI)
qed
lemma ket_nonzero[simp]: "ket i ≠ 0"
using norm_ket[of i] by force
lemma cindependent_ket:
"cindependent (range (ket::'a⇒_))"
proof-
define S where "S = range (ket::'a⇒_)"
have "is_ortho_set S"
unfolding S_def is_ortho_set_def by auto
moreover have "0 ∉ S"
unfolding S_def
using ket_nonzero
by (simp add: image_iff)
ultimately show ?thesis
using is_ortho_set_cindependent[where A = S] unfolding S_def
by blast
qed
lemma cdim_UNIV_ell2[simp]: ‹cdim (UNIV::'a::finite ell2 set) = CARD('a)›
apply (subst cspan_range_ket_finite[symmetric])
by (metis card_image cindependent_ket complex_vector.dim_span_eq_card_independent inj_ket)
lemma is_ortho_set_ket[simp]: ‹is_ortho_set (range ket)›
using is_ortho_set_def by fastforce
subsection ‹Butterflies›
lemma cspan_butterfly_ket: ‹cspan {butterfly (ket i) (ket j)| (i::'b::finite) (j::'a::finite). True} = UNIV›
proof -
have *: ‹{butterfly (ket i) (ket j)| (i::'b::finite) (j::'a::finite). True} = {butterfly a b |a b. a ∈ range ket ∧ b ∈ range ket}›
by auto
show ?thesis
apply (subst *)
apply (rule cspan_butterfly_UNIV)
by auto
qed
lemma cindependent_butterfly_ket: ‹cindependent {butterfly (ket i) (ket j)| (i::'b) (j::'a). True}›
proof -
have *: ‹{butterfly (ket i) (ket j)| (i::'b) (j::'a). True} = {butterfly a b |a b. a ∈ range ket ∧ b ∈ range ket}›
by auto
show ?thesis
apply (subst *)
apply (rule cindependent_butterfly)
by auto
qed
lemma clinear_eq_butterfly_ketI:
fixes F G :: ‹('a::finite ell2 ⇒⇩C⇩L 'b::finite ell2) ⇒ 'c::complex_vector›
assumes "clinear F" and "clinear G"
assumes "⋀i j. F (butterfly (ket i) (ket j)) = G (butterfly (ket i) (ket j))"
shows "F = G"
apply (rule complex_vector.linear_eq_on_span[where f=F, THEN ext, rotated 3])
apply (subst cspan_butterfly_ket)
using assms by auto
lemma sum_butterfly_ket[simp]: ‹(∑(i::'a::finite)∈UNIV. butterfly (ket i) (ket i)) = id_cblinfun›
apply (rule equal_ket)
apply (subst complex_vector.linear_sum[where f=‹λy. y *⇩V ket _›])
apply (auto simp add: scaleC_cblinfun.rep_eq cblinfun.add_left clinearI butterfly_def cblinfun_compose_image cinner_ket)
apply (subst sum.mono_neutral_cong_right[where S=‹{_}›])
by auto
subsection ‹One-dimensional spaces›
instantiation ell2 :: ("{enum,CARD_1}") one_dim begin
text ‹Note: enum is not needed logically, but without it this instantiation
clashes with ‹instantiation ell2 :: (enum) onb_enum››
instance
proof
show "canonical_basis = [1::'a ell2]"
unfolding canonical_basis_ell2_def
apply transfer
by (simp add: enum_CARD_1[of undefined])
show "a *⇩C 1 * b *⇩C 1 = (a * b) *⇩C (1::'a ell2)" for a b
apply (transfer fixing: a b) by simp
show "x / y = x * inverse y" for x y :: "'a ell2"
by (simp add: divide_inverse)
show "inverse (c *⇩C 1) = inverse c *⇩C (1::'a ell2)" for c :: complex
apply transfer by auto
qed
end
subsection ‹Classical operators›
text ‹We call an operator mapping \<^term>‹ket x› to \<^term>‹ket (π x)› or \<^term>‹0› "classical".
(The meaning is inspired by the fact that in quantum mechanics, such operators usually correspond
to operations with classical interpretation (such as Pauli-X, CNOT, measurement in the computational
basis, etc.))›
definition classical_operator :: "('a⇒'b option) ⇒ 'a ell2 ⇒⇩C⇩L'b ell2" where
"classical_operator π =
(let f = (λt. (case π (inv (ket::'a⇒_) t)
of None ⇒ (0::'b ell2)
| Some i ⇒ ket i))
in
cblinfun_extension (range (ket::'a⇒_)) f)"
definition "classical_operator_exists π ⟷
cblinfun_extension_exists (range ket)
(λt. case π (inv ket t) of None ⇒ 0 | Some i ⇒ ket i)"
lemma classical_operator_existsI:
assumes "⋀x. B *⇩V (ket x) = (case π x of Some i ⇒ ket i | None ⇒ 0)"
shows "classical_operator_exists π"
unfolding classical_operator_exists_def
apply (rule cblinfun_extension_existsI[of _ B])
using assms
by (auto simp: inv_f_f[OF inj_ket])
lemma classical_operator_exists_inj:
assumes "inj_map π"
shows "classical_operator_exists π"
proof -
define C0 where "C0 ψ = (λb. case inv_map π b of None ⇒ 0 | Some x ⇒ ψ x)" for ψ :: "'a⇒complex"
have has_ell2_norm_C0: ‹has_ell2_norm ψ ⟹ has_ell2_norm (C0 ψ)› for ψ
proof -
assume ‹has_ell2_norm ψ›
hence ‹bdd_above (sum (λi. (cmod (ψ i))⇧2) ` Collect finite)›
unfolding has_ell2_norm_def
by blast
hence ‹∃ M. ∀ S. finite S ⟶ ( sum (λi. (cmod (ψ i))⇧2) S ) ≤ M›
by (simp add: bdd_above_def)
then obtain M::real where ‹⋀ S::'a set. finite S ⟹ ( sum (λi. (cmod (ψ i))⇧2) S ) ≤ M›
by blast
define φ::‹'b ⇒ complex› where
‹φ b = (case inv_map π b of None ⇒ 0 | Some x ⇒ ψ x)› for b
have ‹⟦finite R; ∀i∈R. φ i ≠ 0⟧ ⟹ (∑i∈R. (cmod (φ i))⇧2) ≤ M›
for R::‹'b set›
proof-
assume ‹finite R› and ‹∀i∈R. φ i ≠ 0›
from ‹∀i∈R. φ i ≠ 0›
have ‹∀i∈R. ∃ x. Some x = inv_map π i›
unfolding φ_def
by (metis option.case_eq_if option.collapse)
hence ‹∃ f. ∀i∈R. Some (f i) = inv_map π i›
by metis
then obtain f::‹'b⇒'a› where ‹∀i∈R. Some (f i) = inv_map π i›
by blast
define S::‹'a set› where ‹S = f ` R›
have ‹finite S›
using ‹finite R›
by (simp add: S_def)
moreover have ‹(∑i∈R. (cmod (φ i))⇧2) = (∑i∈S. (cmod (ψ i))⇧2)›
proof-
have ‹inj_on f R›
proof(rule inj_onI)
fix x y :: 'b
assume ‹x ∈ R› and ‹y ∈ R› and ‹f x = f y›
from ‹∀i∈R. Some (f i) = inv_map π i›
have ‹∀i∈R. Some (f i) = Some (inv π (Some i))›
by (metis inv_map_def option.distinct(1))
hence ‹∀i∈R. f i = inv π (Some i)›
by blast
hence ‹∀i∈R. π (f i) = Some i›
by (metis ‹∀i∈R. Some (f i) = inv_map π i› f_inv_into_f inv_map_def option.distinct(1))
have ‹π (f x) = Some x›
using ‹∀i∈R. π (f i) = Some i› ‹x∈R› by blast
moreover have ‹π (f y) = Some y›
using ‹∀i∈R. π (f i) = Some i› ‹y∈R› by blast
ultimately have ‹Some x = Some y›
using ‹f x = f y› by metis
thus ‹x = y› by simp
qed
moreover have ‹i ∈ R ⟹ (cmod (φ i))⇧2 = (cmod (ψ (f i)))⇧2›
for i
proof-
assume ‹i ∈ R›
hence ‹φ i = ψ (f i)›
unfolding φ_def
by (metis ‹∀i∈R. Some (f i) = inv_map π i› option.simps(5))
thus ?thesis
by simp
qed
ultimately show ?thesis unfolding S_def
by (metis (mono_tags, lifting) sum.reindex_cong)
qed
ultimately show ?thesis
by (simp add: ‹⋀S. finite S ⟹ (∑i∈S. (cmod (ψ i))⇧2) ≤ M›)
qed
have ‹finite R ⟹ ( sum (λi. (cmod (φ i))⇧2) R ) ≤ M›
for R::‹'b set›
proof-
assume ‹finite R›
define U::‹'b set› where ‹U = {i | i::'b. i ∈ R ∧ φ i ≠ 0 }›
define V::‹'b set› where ‹V = {i | i::'b. i ∈ R ∧ φ i = 0 }›
have ‹U ∩ V = {}›
unfolding U_def V_def by blast
moreover have ‹U ∪ V = R›
unfolding U_def V_def by blast
ultimately have ‹( sum (λi. (cmod (φ i))⇧2) R ) = ( sum (λi. (cmod (φ i))⇧2) U ) +
( sum (λi. (cmod (φ i))⇧2) V )›
using ‹finite R› sum.union_disjoint by auto
moreover have ‹( sum (λi. (cmod (φ i))⇧2) V ) = 0›
unfolding V_def by auto
ultimately have ‹( sum (λi. (cmod (φ i))⇧2) R ) = ( sum (λi. (cmod (φ i))⇧2) U )›
by simp
moreover have ‹∀ i ∈ U. φ i ≠ 0›
by (simp add: U_def)
moreover have ‹finite U›
unfolding U_def using ‹finite R›
by simp
ultimately have ‹( sum (λi. (cmod (φ i))⇧2) U ) ≤ M›
using ‹⋀R. ⟦finite R; ∀i∈R. φ i ≠ 0⟧ ⟹ (∑i∈R. (cmod (φ i))⇧2) ≤ M› by blast
thus ?thesis using ‹( sum (λi. (cmod (φ i))⇧2) R ) = ( sum (λi. (cmod (φ i))⇧2) U )›
by simp
qed
hence ‹bdd_above (sum (λi. (cmod (φ i))⇧2) ` Collect finite)›
unfolding bdd_above_def
by blast
thus ?thesis
unfolding φ_def C0_def using has_ell2_norm_def by blast
qed
define C1 :: "('a ell2 ⇒ 'b ell2)"
where "C1 ψ = Abs_ell2 (C0 (Rep_ell2 ψ))" for ψ
have [transfer_rule]: "rel_fun (pcr_ell2 (=)) (pcr_ell2 (=)) C0 C1"
apply (rule rel_funI)
unfolding ell2.pcr_cr_eq cr_ell2_def C1_def
apply (subst Abs_ell2_inverse)
using has_ell2_norm_C0 Rep_ell2 by blast+
have add: "C1 (x + y) = C1 x + C1 y" for x y
apply transfer unfolding C0_def
apply (rule ext, rename_tac b)
apply (case_tac "inv_map π b")
by auto
have scaleC: "C1 (c *⇩C x) = c *⇩C C1 x" for c x
apply transfer unfolding C0_def
apply (rule ext, rename_tac b)
apply (case_tac "inv_map π b")
by auto
have "clinear C1"
using add scaleC by (rule clinearI)
have bounded_C0: ‹ell2_norm (C0 ψ) ≤ ell2_norm ψ› if ‹has_ell2_norm ψ› for ψ
proof-
have ‹∀ S. finite S ⟶ ( sum (λi. (cmod (ψ i))⇧2) S ) ≤ (ell2_norm ψ)^2›
using ‹has_ell2_norm ψ› ell2_norm_def
by (smt cSUP_upper has_ell2_norm_def mem_Collect_eq sqrt_le_D sum.cong)
define φ::‹'b ⇒ complex› where
‹φ b = (case inv_map π b of None ⇒ 0 | Some x ⇒ ψ x)› for b
have ‹⟦finite R; ∀i∈R. φ i ≠ 0⟧ ⟹ (∑i∈R. (cmod (φ i))⇧2) ≤ (ell2_norm ψ)^2›
for R::‹'b set›
proof-
assume ‹finite R› and ‹∀i∈R. φ i ≠ 0›
from ‹∀i∈R. φ i ≠ 0›
have ‹∀i∈R. ∃ x. Some x = inv_map π i›
unfolding φ_def
by (metis option.case_eq_if option.collapse)
hence ‹∃ f. ∀i∈R. Some (f i) = inv_map π i›
by metis
then obtain f::‹'b⇒'a› where ‹∀i∈R. Some (f i) = inv_map π i›
by blast
define S::‹'a set› where ‹S = f ` R›
have ‹finite S›
using ‹finite R›
by (simp add: S_def)
moreover have ‹(∑i∈R. (cmod (φ i))⇧2) = (∑i∈S. (cmod (ψ i))⇧2)›
proof-
have ‹inj_on f R›
proof(rule inj_onI)
fix x y :: 'b
assume ‹x ∈ R› and ‹y ∈ R› and ‹f x = f y›
from ‹∀i∈R. Some (f i) = inv_map π i›
have ‹∀i∈R. Some (f i) = Some (inv π (Some i))›
by (metis inv_map_def option.distinct(1))
hence ‹∀i∈R. f i = inv π (Some i)›
by blast
hence ‹∀i∈R. π (f i) = Some i›
by (metis ‹∀i∈R. Some (f i) = inv_map π i› f_inv_into_f inv_map_def option.distinct(1))
have ‹π (f x) = Some x›
using ‹∀i∈R. π (f i) = Some i› ‹x∈R› by blast
moreover have ‹π (f y) = Some y›
using ‹∀i∈R. π (f i) = Some i› ‹y∈R› by blast
ultimately have ‹Some x = Some y›
using ‹f x = f y› by metis
thus ‹x = y› by simp
qed
moreover have ‹i ∈ R ⟹ (cmod (φ i))⇧2 = (cmod (ψ (f i)))⇧2›
for i
proof-
assume ‹i ∈ R›
hence ‹φ i = ψ (f i)›
unfolding φ_def
by (metis ‹∀i∈R. Some (f i) = inv_map π i› option.simps(5))
thus ?thesis
by simp
qed
ultimately show ?thesis unfolding S_def
by (metis (mono_tags, lifting) sum.reindex_cong)
qed
ultimately show ?thesis
by (simp add: ‹∀S. finite S ⟶ (∑i∈S. (cmod (ψ i))⇧2) ≤ (ell2_norm ψ)⇧2›)
qed
have ‹finite R ⟹ ( sum (λi. (cmod (φ i))⇧2) R ) ≤ (ell2_norm ψ)⇧2›
for R::‹'b set›
proof-
assume ‹finite R›
define U::‹'b set› where ‹U = {i | i::'b. i ∈ R ∧ φ i ≠ 0 }›
define V::‹'b set› where ‹V = {i | i::'b. i ∈ R ∧ φ i = 0 }›
have ‹U ∩ V = {}›
unfolding U_def V_def by blast
moreover have ‹U ∪ V = R›
unfolding U_def V_def by blast
ultimately have ‹( sum (λi. (cmod (φ i))⇧2) R ) = ( sum (λi. (cmod (φ i))⇧2) U ) +
( sum (λi. (cmod (φ i))⇧2) V )›
using ‹finite R› sum.union_disjoint by auto
moreover have ‹( sum (λi. (cmod (φ i))⇧2) V ) = 0›
unfolding V_def by auto
ultimately have ‹( sum (λi. (cmod (φ i))⇧2) R ) = ( sum (λi. (cmod (φ i))⇧2) U )›
by simp
moreover have ‹∀ i ∈ U. φ i ≠ 0›
by (simp add: U_def)
moreover have ‹finite U›
unfolding U_def using ‹finite R›
by simp
ultimately have ‹( sum (λi. (cmod (φ i))⇧2) U ) ≤ (ell2_norm ψ)⇧2›
using ‹⋀R. ⟦finite R; ∀i∈R. φ i ≠ 0⟧ ⟹ (∑i∈R. (cmod (φ i))⇧2) ≤ (ell2_norm ψ)⇧2› by blast
thus ?thesis using ‹( sum (λi. (cmod (φ i))⇧2) R ) = ( sum (λi. (cmod (φ i))⇧2) U )›
by simp
qed
hence ‹finite R ⟹ sqrt (∑i∈R. (cmod (φ i))⇧2) ≤ ell2_norm ψ›
for R
proof-
assume ‹finite R›
hence ‹(∑i∈R. (cmod (φ i))⇧2) ≤ (ell2_norm ψ)^2›
by (simp add: ‹⋀R. finite R ⟹ (∑i∈R. (cmod (φ i))⇧2) ≤ (ell2_norm ψ)⇧2›)
hence ‹sqrt (∑i∈R. (cmod (φ i))⇧2) ≤ sqrt ((ell2_norm ψ)^2)›
using real_sqrt_le_iff by blast
moreover have ‹sqrt ((ell2_norm ψ)^2) = ell2_norm ψ›
proof-
have ‹ell2_norm ψ ≥ 0›
proof-
obtain X where ‹Rep_ell2 X = ψ›
using Rep_ell2_cases ‹has_ell2_norm ψ› by auto
have ‹norm X ≥ 0›
by simp
thus ‹ell2_norm ψ ≥ 0›
using ‹Rep_ell2 X = ψ›
by (simp add: norm_ell2.rep_eq)
qed
thus ?thesis
by simp
qed
ultimately show ?thesis
by linarith
qed
hence ‹∀ L ∈ { sqrt (sum (λi. norm (φ i)^2) F) | F. F∈{F. finite F} }. L ≤ ell2_norm ψ›
by blast
moreover have ‹{ sqrt (sum (λi. norm (φ i)^2) F) | F. F∈{F. finite F} } ≠ {}›
by force
ultimately have ‹Sup { sqrt (sum (λi. norm (φ i)^2) F) | F. F∈{F. finite F} } ≤ ell2_norm ψ›
by (meson cSup_least)
moreover have ‹sqrt ( Sup { sum (λi. norm (φ i)^2) F | F. F∈{F. finite F} } )
= Sup { sqrt (sum (λi. norm (φ i)^2) F) | F. F∈{F. finite F} }›
proof-
define T where ‹T = { sum (λi. norm (φ i)^2) F | F. F∈{F. finite F} }›
have ‹mono sqrt›
by (simp add: monoI)
moreover have ‹continuous (at_left (Sup T)) sqrt›
by (simp add: continuous_at_imp_continuous_at_within isCont_real_sqrt)
moreover have ‹T ≠ {}›
unfolding T_def
by blast
moreover have ‹bdd_above T›
proof(rule bdd_aboveI)
fix x
assume ‹x ∈ T›
hence ‹∃ R. finite R ∧ x = ( sum (λi. (cmod (φ i))⇧2) R )›
unfolding T_def
by blast
then obtain R where ‹finite R› and ‹x = ( sum (λi. (cmod (φ i))⇧2) R )›
by blast
from ‹finite R›
have ‹( sum (λi. (cmod (φ i))⇧2) R ) ≤ (ell2_norm ψ)^2›
by (simp add: ‹⋀R. finite R ⟹ (∑i∈R. (cmod (φ i))⇧2) ≤ (ell2_norm ψ)⇧2›)
thus ‹x ≤ (ell2_norm ψ)^2›
using ‹x = ( sum (λi. (cmod (φ i))⇧2) R )› by simp
qed
ultimately have ‹sqrt (Sup T) = Sup (sqrt ` T)›
by (rule Topological_Spaces.continuous_at_Sup_mono)
moreover have ‹sqrt ` {∑i∈F. (cmod (φ i))⇧2 |F. F ∈ Collect finite}
= {sqrt (∑i∈F. (cmod (φ i))⇧2) |F. F ∈ Collect finite}›
by auto
ultimately show ?thesis
unfolding T_def
by simp
qed
ultimately have ‹sqrt ( Sup { sum (λi. norm (φ i)^2) F | F. F∈{F. finite F} } ) ≤ ell2_norm ψ›
by simp
moreover have ‹ell2_norm φ = sqrt ( Sup { sum (λi. norm (φ i)^2) F | F. F∈{F. finite F} } )›
unfolding ell2_norm_def
by (metis Setcompr_eq_image)
ultimately have ‹ell2_norm φ ≤ ell2_norm ψ›
by simp
thus ?thesis
unfolding C0_def φ_def by simp
qed
hence bounded_C1: "∃K. ∀x. norm (C1 x) ≤ norm x * K"
apply transfer apply (rule exI[of _ 1]) by auto
have "bounded_clinear C1"
using ‹clinear C1› bounded_C1
using add bounded_clinear_intro scaleC by blast
define C where "C = CBlinfun C1"
have [transfer_rule]: "pcr_cblinfun (=) (=) C1 C"
unfolding C_def unfolding cblinfun.pcr_cr_eq cr_cblinfun_def
apply (subst CBlinfun_inverse)
using ‹bounded_clinear C1› by auto
have C1_ket: "C1 (ket x) = (case π x of Some i ⇒ ket i | None ⇒ 0)" for x
apply (transfer fixing: π x) unfolding C0_def
apply (rule ext, rename_tac b)
apply (case_tac "inv_map π b"; cases "π x")
apply auto
apply (metis inv_map_def option.simps(3) range_eqI)
apply (metis f_inv_into_f inv_map_def option.distinct(1) option.sel)
apply (metis f_inv_into_f inv_map_def option.sel option.simps(3))
by (metis (no_types, lifting) assms f_inv_into_f inj_map_def inv_map_def option.sel option.simps(3))
have "C *⇩V ket x = (case π x of None ⇒ 0 | Some i ⇒ ket i)" for x
using ket.transfer[transfer_rule del] zero_ell2.transfer[transfer_rule del]
apply (tactic ‹all_tac›)
apply (transfer fixing: π)
by (fact C1_ket)
thus "classical_operator_exists π"
by (rule classical_operator_existsI[of C])
qed
lemma classical_operator_exists_finite[simp]: "classical_operator_exists (π :: _::finite ⇒ _)"
unfolding classical_operator_exists_def
apply (rule cblinfun_extension_exists_finite_dim)
using cindependent_ket apply blast
using finite_class.finite_UNIV finite_imageI closed_cspan_range_ket closure_finite_cspan by blast
lemma classical_operator_ket:
assumes "classical_operator_exists π"
shows "(classical_operator π) *⇩V (ket x) = (case π x of Some i ⇒ ket i | None ⇒ 0)"
unfolding classical_operator_def
using f_inv_into_f ket_injective rangeI
by (metis assms cblinfun_extension_apply classical_operator_exists_def)
lemma classical_operator_ket_finite:
"(classical_operator π) *⇩V (ket (x::'a::finite)) = (case π x of Some i ⇒ ket i | None ⇒ 0)"
by (rule classical_operator_ket, simp)
lemma classical_operator_adjoint[simp]:
fixes π :: "'a ⇒ 'b option"
assumes a1: "inj_map π"
shows "(classical_operator π)* = classical_operator (inv_map π)"
proof-
define F where "F = classical_operator (inv_map π)"
define G where "G = classical_operator π"
have "⟨F *⇩V ket i, ket j⟩ = ⟨ket i, G *⇩V ket j⟩" for i j
proof-
have w1: "(classical_operator (inv_map π)) *⇩V (ket i)
= (case inv_map π i of Some k ⇒ ket k | None ⇒ 0)"
by (simp add: classical_operator_ket classical_operator_exists_inj)
have w2: "(classical_operator π) *⇩V (ket j)
= (case π j of Some k ⇒ ket k | None ⇒ 0)"
by (simp add: assms classical_operator_ket classical_operator_exists_inj)
have "⟨F *⇩V ket i, ket j⟩ = ⟨classical_operator (inv_map π) *⇩V ket i, ket j⟩"
unfolding F_def by blast
also have "… = ⟨(case inv_map π i of Some k ⇒ ket k | None ⇒ 0), ket j⟩"
using w1 by simp
also have "… = ⟨ket i, (case π j of Some k ⇒ ket k | None ⇒ 0)⟩"
proof(induction "inv_map π i")
case None
hence pi1: "None = inv_map π i".
show ?case
proof (induction "π j")
case None
thus ?case
using pi1 by auto
next
case (Some c)
have "c ≠ i"
proof(rule classical)
assume "¬(c ≠ i)"
hence "c = i"
by blast
hence "inv_map π c = inv_map π i"
by simp
hence "inv_map π c = None"
by (simp add: pi1)
moreover have "inv_map π c = Some j"
using Some.hyps unfolding inv_map_def
apply auto
by (metis a1 f_inv_into_f inj_map_def option.distinct(1) rangeI)
ultimately show ?thesis by simp
qed
thus ?thesis
by (metis None.hyps Some.hyps cinner_zero_left orthogonal_ket option.simps(4)
option.simps(5))
qed
next
case (Some d)
hence s1: "Some d = inv_map π i".
show "⟨case inv_map π i of
None ⇒ 0
| Some a ⇒ ket a, ket j⟩ =
⟨ket i, case π j of
None ⇒ 0
| Some a ⇒ ket a⟩"
proof(induction "π j")
case None
have "d ≠ j"
proof(rule classical)
assume "¬(d ≠ j)"
hence "d = j"
by blast
hence "π d = π j"
by simp
hence "π d = None"
by (simp add: None.hyps)
moreover have "π d = Some i"
using Some.hyps unfolding inv_map_def
apply auto
by (metis f_inv_into_f option.distinct(1) option.inject)
ultimately show ?thesis
by simp
qed
thus ?case
by (metis None.hyps Some.hyps cinner_zero_right orthogonal_ket option.case_eq_if
option.simps(5))
next
case (Some c)
hence s2: "π j = Some c" by simp
have "⟨ket d, ket j⟩ = ⟨ket i, ket c⟩"
proof(cases "π j = Some i")
case True
hence ij: "Some j = inv_map π i"
unfolding inv_map_def apply auto
apply (metis a1 f_inv_into_f inj_map_def option.discI range_eqI)
by (metis range_eqI)
have "i = c"
using True s2 by auto
moreover have "j = d"
by (metis option.inject s1 ij)
ultimately show ?thesis
by (simp add: cinner_ket_same)
next
case False
moreover have "π d = Some i"
using s1 unfolding inv_map_def
by (metis f_inv_into_f option.distinct(1) option.inject)
ultimately have "j ≠ d"
by auto
moreover have "i ≠ c"
using False s2 by auto
ultimately show ?thesis
by (metis orthogonal_ket)
qed
hence "⟨case Some d of None ⇒ 0
| Some a ⇒ ket a, ket j⟩ =
⟨ket i, case Some c of None ⇒ 0 | Some a ⇒ ket a⟩"
by simp
thus "⟨case inv_map π i of None ⇒ 0
| Some a ⇒ ket a, ket j⟩ =
⟨ket i, case π j of None ⇒ 0 | Some a ⇒ ket a⟩"
by (simp add: Some.hyps s1)
qed
qed
also have "… = ⟨ket i, classical_operator π *⇩V ket j⟩"
by (simp add: w2)
also have "… = ⟨ket i, G *⇩V ket j⟩"
unfolding G_def by blast
finally show ?thesis .
qed
hence "G* = F"
using cinner_ket_adjointI
by auto
thus ?thesis unfolding G_def F_def .
qed
lemma
fixes π::"'b ⇒ 'c option" and ρ::"'a ⇒ 'b option"
assumes "classical_operator_exists π"
assumes "classical_operator_exists ρ"
shows classical_operator_exists_comp[simp]: "classical_operator_exists (π ∘⇩m ρ)"
and classical_operator_mult[simp]: "classical_operator π o⇩C⇩L classical_operator ρ = classical_operator (π ∘⇩m ρ)"
proof -
define Cπ Cρ Cπρ where "Cπ = classical_operator π" and "Cρ = classical_operator ρ"
and "Cπρ = classical_operator (π ∘⇩m ρ)"
have Cπx: "Cπ *⇩V (ket x) = (case π x of Some i ⇒ ket i | None ⇒ 0)" for x
unfolding Cπ_def using ‹classical_operator_exists π› by (rule classical_operator_ket)
have Cρx: "Cρ *⇩V (ket x) = (case ρ x of Some i ⇒ ket i | None ⇒ 0)" for x
unfolding Cρ_def using ‹classical_operator_exists ρ› by (rule classical_operator_ket)
have Cπρx': "(Cπ o⇩C⇩L Cρ) *⇩V (ket x) = (case (π ∘⇩m ρ) x of Some i ⇒ ket i | None ⇒ 0)" for x
apply (simp add: scaleC_cblinfun.rep_eq Cρx)
apply (cases "ρ x")
by (auto simp: Cπx)
thus ‹classical_operator_exists (π ∘⇩m ρ)›
by (rule classical_operator_existsI)
hence "Cπρ *⇩V (ket x) = (case (π ∘⇩m ρ) x of Some i ⇒ ket i | None ⇒ 0)" for x
unfolding Cπρ_def
by (rule classical_operator_ket)
with Cπρx' have "(Cπ o⇩C⇩L Cρ) *⇩V (ket x) = Cπρ *⇩V (ket x)" for x
by simp
thus "Cπ o⇩C⇩L Cρ = Cπρ"
by (simp add: equal_ket)
qed
lemma classical_operator_Some[simp]: "classical_operator (Some::'a⇒_) = id_cblinfun"
proof-
have "(classical_operator Some) *⇩V (ket i) = id_cblinfun *⇩V (ket i)"
for i::'a
apply (subst classical_operator_ket)
apply (rule classical_operator_exists_inj)
by auto
thus ?thesis
using equal_ket[where A = "classical_operator (Some::'a ⇒ _ option)"
and B = "id_cblinfun::'a ell2 ⇒⇩C⇩L _"]
by blast
qed
lemma isometry_classical_operator[simp]:
fixes π::"'a ⇒ 'b"
assumes a1: "inj π"
shows "isometry (classical_operator (Some o π))"
proof -
have b0: "inj_map (Some ∘ π)"
by (simp add: a1)
have b0': "inj_map (inv_map (Some ∘ π))"
by simp
have b1: "inv_map (Some ∘ π) ∘⇩m (Some ∘ π) = Some"
apply (rule ext) unfolding inv_map_def o_def
using assms unfolding inj_def inv_def by auto
have b3: "classical_operator (inv_map (Some ∘ π)) o⇩C⇩L
classical_operator (Some ∘ π) = classical_operator (inv_map (Some ∘ π) ∘⇩m (Some ∘ π))"
by (metis b0 b0' b1 classical_operator_Some classical_operator_exists_inj
classical_operator_mult)
show ?thesis
unfolding isometry_def
apply (subst classical_operator_adjoint)
using b0 by (auto simp add: b1 b3)
qed
lemma unitary_classical_operator[simp]:
fixes π::"'a ⇒ 'b"
assumes a1: "bij π"
shows "unitary (classical_operator (Some o π))"
proof (unfold unitary_def, rule conjI)
have "inj π"
using a1 bij_betw_imp_inj_on by auto
hence "isometry (classical_operator (Some o π))"
by simp
hence "classical_operator (Some ∘ π)* o⇩C⇩L classical_operator (Some ∘ π) = id_cblinfun"
unfolding isometry_def by simp
thus ‹classical_operator (Some ∘ π)* o⇩C⇩L classical_operator (Some ∘ π) = id_cblinfun›
by simp
next
have "inj π"
by (simp add: assms bij_is_inj)
have comp: "Some ∘ π ∘⇩m inv_map (Some ∘ π) = Some"
apply (rule ext)
unfolding inv_map_def o_def map_comp_def
unfolding inv_def apply auto
apply (metis ‹inj π› inv_def inv_f_f)
using bij_def image_iff range_eqI
by (metis a1)
have "classical_operator (Some ∘ π) o⇩C⇩L classical_operator (Some ∘ π)*
= classical_operator (Some ∘ π) o⇩C⇩L classical_operator (inv_map (Some ∘ π))"
by (simp add: ‹inj π›)
also have "… = classical_operator ((Some ∘ π) ∘⇩m (inv_map (Some ∘ π)))"
by (simp add: ‹inj π› classical_operator_exists_inj)
also have "… = classical_operator (Some::'b⇒_)"
using comp
by simp
also have "… = (id_cblinfun:: 'b ell2 ⇒⇩C⇩L _)"
by simp
finally show "classical_operator (Some ∘ π) o⇩C⇩L classical_operator (Some ∘ π)* = id_cblinfun".
qed
unbundle no_cblinfun_notation
end
Theory Cblinfun_Matrix
section ‹‹Cblinfun_Matrix› -- Matrix representation of bounded operators›
theory Cblinfun_Matrix
imports
Complex_L2
"Jordan_Normal_Form.Gram_Schmidt"
"HOL-Analysis.Starlike"
"Complex_Bounded_Operators.Extra_Jordan_Normal_Form"
begin
hide_const (open) Order.bottom Order.top
hide_type (open) Finite_Cartesian_Product.vec
hide_const (open) Finite_Cartesian_Product.mat
hide_fact (open) Finite_Cartesian_Product.mat_def
hide_const (open) Finite_Cartesian_Product.vec
hide_fact (open) Finite_Cartesian_Product.vec_def
hide_const (open) Finite_Cartesian_Product.row
hide_fact (open) Finite_Cartesian_Product.row_def
no_notation Finite_Cartesian_Product.vec_nth (infixl "$" 90)
unbundle jnf_notation
unbundle cblinfun_notation
subsection ‹Isomorphism between vectors›
text ‹We define the canonical isomorphism between vectors in some complex vector space \<^typ>‹'a::basis_enum› and the
complex \<^term>‹n›-dimensional vectors (where \<^term>‹n› is the dimension of \<^typ>‹'a›).
This is possible if \<^typ>‹'a›, \<^typ>‹'b› are of class \<^class>‹basis_enum›
since that class fixes a finite canonical basis. Vector are represented using
the \<^typ>‹complex vec› type from \<^session>‹Jordan_Normal_Form›.
(The isomorphism will be called \<^term>‹vec_of_onb_enum› below.)›
definition vec_of_basis_enum :: ‹'a::basis_enum ⇒ complex vec› where
‹vec_of_basis_enum v = vec_of_list (map (crepresentation (set canonical_basis) v) canonical_basis)›
lemma dim_vec_of_basis_enum'[simp]:
‹dim_vec (vec_of_basis_enum (v::'a)) = length (canonical_basis::'a::basis_enum list)›
unfolding vec_of_basis_enum_def
by simp
definition basis_enum_of_vec :: ‹complex vec ⇒ 'a::basis_enum› where
‹basis_enum_of_vec v =
(if dim_vec v = length (canonical_basis :: 'a list)
then sum_list (map2 (*⇩C) (list_of_vec v) (canonical_basis::'a list))
else 0)›
lemma vec_of_basis_enum_inverse[simp]:
fixes w::"'a::basis_enum"
shows "basis_enum_of_vec (vec_of_basis_enum w) = w"
unfolding vec_of_basis_enum_def basis_enum_of_vec_def
unfolding list_vec zip_map1 zip_same_conv_map map_map
apply (simp add: o_def)
apply (subst sum.distinct_set_conv_list[symmetric], simp)
apply (rule complex_vector.sum_representation_eq)
using is_generator_set by auto
lemma basis_enum_of_vec_inverse[simp]:
fixes v::"complex vec"
defines "n ≡ length (canonical_basis :: 'a::basis_enum list)"
assumes f1: "dim_vec v = n"
shows "vec_of_basis_enum ((basis_enum_of_vec v)::'a) = v"
proof (rule eq_vecI)
show ‹dim_vec (vec_of_basis_enum (basis_enum_of_vec v :: 'a)) = dim_vec v›
by (auto simp: vec_of_basis_enum_def f1 n_def)
next
fix j assume j_v: ‹j < dim_vec v›
define w where "w = list_of_vec v"
define basis where "basis = (canonical_basis::'a list)"
have [simp]: "length w = n" "length basis = n" ‹dim_vec v = n› ‹length (canonical_basis::'a list) = n›
‹j < n›
using j_v by (auto simp: f1 basis_def w_def n_def)
have [simp]: ‹cindependent (set basis)› ‹cspan (set basis) = UNIV›
by (auto simp: basis_def is_cindependent_set is_generator_set)
have ‹vec_of_basis_enum ((basis_enum_of_vec v)::'a) $ j
= map (crepresentation (set basis) (sum_list (map2 (*⇩C) w basis))) basis ! j›
by (auto simp: vec_of_list_index vec_of_basis_enum_def basis_enum_of_vec_def simp flip: w_def basis_def)
also have ‹… = crepresentation (set basis) (sum_list (map2 (*⇩C) w basis)) (basis!j)›
by simp
also have ‹… = crepresentation (set basis) (∑i<n. (w!i) *⇩C (basis!i)) (basis!j)›
by (auto simp: sum_list_sum_nth atLeast0LessThan)
also have ‹… = (∑i<n. (w!i) *⇩C crepresentation (set basis) (basis!i) (basis!j))›
by (auto simp: complex_vector.representation_sum complex_vector.representation_scale)
also have ‹… = w!j›
apply (subst sum_single[where i=j])
apply (auto simp: complex_vector.representation_basis)
using ‹j < n› ‹length basis = n› basis_def distinct_canonical_basis nth_eq_iff_index_eq by blast
also have ‹… = v $ j›
by (simp add: w_def)
finally show ‹vec_of_basis_enum (basis_enum_of_vec v :: 'a) $ j = v $ j›
by -
qed
lemma basis_enum_eq_vec_of_basis_enumI:
fixes a b :: "_::basis_enum"
assumes "vec_of_basis_enum a = vec_of_basis_enum b"
shows "a = b"
by (metis assms vec_of_basis_enum_inverse)
subsection ‹Operations on vectors›
lemma basis_enum_of_vec_add:
assumes [simp]: ‹dim_vec v1 = length (canonical_basis :: 'a::basis_enum list)›
‹dim_vec v2 = length (canonical_basis :: 'a list)›
shows ‹((basis_enum_of_vec (v1 + v2)) :: 'a) = basis_enum_of_vec v1 + basis_enum_of_vec v2›
proof -
have ‹length (list_of_vec v1) = length (list_of_vec v2)› and ‹length (list_of_vec v2) = length (canonical_basis :: 'a list)›
by simp_all
then have ‹sum_list (map2 (*⇩C) (map2 (+) (list_of_vec v1) (list_of_vec v2)) (canonical_basis::'a list))
= sum_list (map2 (*⇩C) (list_of_vec v1) canonical_basis) + sum_list (map2 (*⇩C) (list_of_vec v2) canonical_basis)›
apply (induction rule: list_induct3)
by (auto simp: scaleC_add_left)
then show ?thesis
using assms by (auto simp: basis_enum_of_vec_def list_of_vec_plus)
qed
lemma basis_enum_of_vec_mult:
assumes [simp]: ‹dim_vec v = length (canonical_basis :: 'a::basis_enum list)›
shows ‹((basis_enum_of_vec (c ⋅⇩v v)) :: 'a) = c *⇩C basis_enum_of_vec v›
proof -
have *: ‹monoid_add_hom ((*⇩C) c :: 'a ⇒ _)›
by (simp add: monoid_add_hom_def plus_hom.intro scaleC_add_right semigroup_add_hom.intro zero_hom.intro)
show ?thesis
apply (auto simp: basis_enum_of_vec_def list_of_vec_mult map_zip_map
monoid_add_hom.hom_sum_list[OF *])
by (metis case_prod_unfold comp_apply scaleC_scaleC)
qed
lemma vec_of_basis_enum_add:
"vec_of_basis_enum (b1 + b2) = vec_of_basis_enum b1 + vec_of_basis_enum b2"
by (auto simp: vec_of_basis_enum_def complex_vector.representation_add)
lemma vec_of_basis_enum_scaleC:
"vec_of_basis_enum (c *⇩C b) = c ⋅⇩v (vec_of_basis_enum b)"
by (auto simp: vec_of_basis_enum_def complex_vector.representation_scale)
lemma vec_of_basis_enum_scaleR:
"vec_of_basis_enum (r *⇩R b) = complex_of_real r ⋅⇩v (vec_of_basis_enum b)"
by (simp add: scaleR_scaleC vec_of_basis_enum_scaleC)
lemma vec_of_basis_enum_uminus:
"vec_of_basis_enum (- b2) = - vec_of_basis_enum b2"
unfolding scaleC_minus1_left[symmetric, of b2]
unfolding scaleC_minus1_left_vec[symmetric]
by (rule vec_of_basis_enum_scaleC)
lemma vec_of_basis_enum_minus:
"vec_of_basis_enum (b1 - b2) = vec_of_basis_enum b1 - vec_of_basis_enum b2"
by (metis (mono_tags, hide_lams) carrier_vec_dim_vec diff_conv_add_uminus diff_zero index_add_vec(2) minus_add_uminus_vec vec_of_basis_enum_add vec_of_basis_enum_uminus)
lemma cinner_basis_enum_of_vec:
defines "n ≡ length (canonical_basis :: 'a::onb_enum list)"
assumes [simp]: "dim_vec x = n" "dim_vec y = n"
shows "⟨basis_enum_of_vec x :: 'a, basis_enum_of_vec y⟩ = y ∙c x"
proof -
have ‹⟨basis_enum_of_vec x :: 'a, basis_enum_of_vec y⟩
= (∑i<n. x$i *⇩C canonical_basis ! i :: 'a) ∙⇩C (∑i<n. y$i *⇩C canonical_basis ! i)›
by (auto simp: basis_enum_of_vec_def sum_list_sum_nth atLeast0LessThan simp flip: n_def)
also have ‹… = (∑i<n. ∑j<n. cnj (x$i) *⇩C y$j *⇩C ((canonical_basis ! i :: 'a) ∙⇩C (canonical_basis ! j)))›
apply (subst cinner_sum_left)
apply (subst cinner_sum_right)
by (auto simp: mult_ac)
also have ‹… = (∑i<n. ∑j<n. cnj (x$i) *⇩C y$j *⇩C (if i=j then 1 else 0))›
apply (rule sum.cong[OF refl])
apply (rule sum.cong[OF refl])
by (auto simp: cinner_canonical_basis n_def)
also have ‹… = (∑i<n. cnj (x$i) *⇩C y$i)›
apply (rule sum.cong[OF refl])
apply (subst sum_single)
by auto
also have ‹… = y ∙c x›
by (smt (z3) assms(2) complex_scaleC_def conjugate_complex_def dim_vec_conjugate lessThan_atLeast0 lessThan_iff mult.commute scalar_prod_def sum.cong vec_index_conjugate)
finally show ?thesis
by -
qed
lemma cscalar_prod_vec_of_basis_enum: "cscalar_prod (vec_of_basis_enum φ) (vec_of_basis_enum ψ) = cinner ψ φ"
for ψ :: "'a::onb_enum"
apply (subst cinner_basis_enum_of_vec[symmetric, where 'a='a])
by simp_all
lemma norm_ell2_vec_of_basis_enum: "norm ψ =
(let ψ' = vec_of_basis_enum ψ in
sqrt (∑ i ∈ {0 ..< dim_vec ψ'}. let z = vec_index ψ' i in (Re z)⇧2 + (Im z)⇧2))"
(is "_ = ?rhs") for ψ :: "'a::onb_enum"
proof -
have "norm ψ = sqrt (cmod (∑i = 0..<dim_vec (vec_of_basis_enum ψ).
vec_of_basis_enum ψ $ i * conjugate (vec_of_basis_enum ψ) $ i))"
unfolding norm_eq_sqrt_cinner[where 'a='a] cscalar_prod_vec_of_basis_enum[symmetric] scalar_prod_def dim_vec_conjugate
by rule
also have "… = sqrt (cmod (∑x = 0..<dim_vec (vec_of_basis_enum ψ).
let z = vec_of_basis_enum ψ $ x in (Re z)⇧2 + (Im z)⇧2))"
apply (subst sum.cong, rule refl)
apply (subst vec_index_conjugate)
by (auto simp: Let_def complex_mult_cnj)
also have "… = ?rhs"
unfolding Let_def norm_of_real
apply (subst abs_of_nonneg)
apply (rule sum_nonneg)
by auto
finally show ?thesis
by -
qed
lemma basis_enum_of_vec_unit_vec:
defines "basis ≡ (canonical_basis::'a::basis_enum list)"
and "n ≡ length (canonical_basis :: 'a list)"
assumes a3: "i < n"
shows "basis_enum_of_vec (unit_vec n i) = basis!i"
proof-
define L::"complex list" where "L = list_of_vec (unit_vec n i)"
define I::"nat list" where "I = [0..<n]"
have "length L = n"
by (simp add: L_def)
moreover have "length basis = n"
by (simp add: basis_def n_def)
ultimately have "map2 (*⇩C) L basis = map (λj. L!j *⇩C basis!j) I"
by (simp add: I_def list_eq_iff_nth_eq)
hence "sum_list (map2 (*⇩C) L basis) = sum_list (map (λj. L!j *⇩C basis!j) I)"
by simp
also have "… = sum (λj. L!j *⇩C basis!j) {0..n-1}"
proof-
have "set I = {0..n-1}"
using I_def a3 by auto
thus ?thesis
using Groups_List.sum_code[where xs = I and g = "(λj. L!j *⇩C basis!j)"]
by (simp add: I_def)
qed
also have "… = sum (λj. (list_of_vec (unit_vec n i))!j *⇩C basis!j) {0..n-1}"
unfolding L_def by blast
finally have "sum_list (map2 (*⇩C) (list_of_vec (unit_vec n i)) basis)
= sum (λj. (list_of_vec (unit_vec n i))!j *⇩C basis!j) {0..n-1}"
using L_def by blast
also have "… = basis ! i"
proof-
have "(∑j = 0..n - 1. list_of_vec (unit_vec n i) ! j *⇩C basis ! j) =
(∑j ∈ {0..n - 1}. list_of_vec (unit_vec n i) ! j *⇩C basis ! j)"
by simp
also have "… = list_of_vec (unit_vec n i) ! i *⇩C basis ! i
+ (∑j ∈ {0..n - 1}-{i}. list_of_vec (unit_vec n i) ! j *⇩C basis ! j)"
proof-
define a where "a j = list_of_vec (unit_vec n i) ! j *⇩C basis ! j" for j
define S where "S = {0..n - 1}"
have "finite S"
by (simp add: S_def)
hence "(∑j ∈ insert i S. a j) = a i + (∑j∈S-{i}. a j)"
using Groups_Big.comm_monoid_add_class.sum.insert_remove
by auto
moreover have "S-{i} = {0..n-1}-{i}"
unfolding S_def
by blast
moreover have "insert i S = {0..n-1}"
using S_def Suc_diff_1 a3 atLeastAtMost_iff diff_is_0_eq' le_SucE le_numeral_extra(4)
less_imp_le not_gr_zero
by fastforce
ultimately show ?thesis
using ‹a ≡ λj. list_of_vec (unit_vec n i) ! j *⇩C basis ! j›
by simp
qed
also have "… = list_of_vec (unit_vec n i) ! i *⇩C basis ! i"
proof-
have "j ∈ {0..n - 1}-{i} ⟹ list_of_vec (unit_vec n i) ! j = 0"
for j
using a3 atMost_atLeast0 atMost_iff diff_Suc_less index_unit_vec(1) le_less_trans
list_of_vec_index member_remove zero_le by fastforce
hence "j ∈ {0..n - 1}-{i} ⟹ list_of_vec (unit_vec n i) ! j *⇩C basis ! j = 0"
for j
by auto
hence "(∑j ∈ {0..n - 1}-{i}. list_of_vec (unit_vec n i) ! j *⇩C basis ! j) = 0"
by (simp add: ‹⋀j. j ∈ {0..n - 1} - {i} ⟹ list_of_vec (unit_vec n i) ! j *⇩C basis ! j = 0›)
thus ?thesis by simp
qed
also have "… = basis ! i"
by (simp add: a3)
finally show ?thesis
using ‹(∑j = 0..n - 1. list_of_vec (unit_vec n i) ! j *⇩C basis ! j)
= list_of_vec (unit_vec n i) ! i *⇩C basis ! i + (∑j∈{0..n - 1} - {i}. list_of_vec (unit_vec n i) ! j *⇩C basis ! j)›
‹list_of_vec (unit_vec n i) ! i *⇩C basis ! i + (∑j∈{0..n - 1} - {i}. list_of_vec (unit_vec n i) ! j *⇩C basis ! j)
= list_of_vec (unit_vec n i) ! i *⇩C basis ! i›
‹list_of_vec (unit_vec n i) ! i *⇩C basis ! i = basis ! i›
by auto
qed
finally have "sum_list (map2 (*⇩C) (list_of_vec (unit_vec n i)) basis)
= basis ! i"
by (simp add: assms)
hence "sum_list (map2 scaleC (list_of_vec (unit_vec n i)) (canonical_basis::'a list))
= (canonical_basis::'a list) ! i"
by (simp add: assms)
thus ?thesis
unfolding basis_enum_of_vec_def
by (simp add: assms)
qed
lemma vec_of_basis_enum_ket:
"vec_of_basis_enum (ket i) = unit_vec (CARD('a)) (enum_idx i)"
for i::"'a::enum"
proof-
have "dim_vec (vec_of_basis_enum (ket i))
= dim_vec (unit_vec (CARD('a)) (enum_idx i))"
proof-
have "dim_vec (unit_vec (CARD('a)) (enum_idx i))
= CARD('a)"
by simp
moreover have "dim_vec (vec_of_basis_enum (ket i)) = CARD('a)"
unfolding vec_of_basis_enum_def vec_of_basis_enum_def by auto
ultimately show ?thesis by simp
qed
moreover have "vec_of_basis_enum (ket i) $ j =
(unit_vec (CARD('a)) (enum_idx i)) $ j"
if "j < dim_vec (vec_of_basis_enum (ket i))"
for j
proof-
have j_bound: "j < length (canonical_basis::'a ell2 list)"
by (metis dim_vec_of_basis_enum' that)
have y1: "cindependent (set (canonical_basis::'a ell2 list))"
using is_cindependent_set by blast
have y2: "canonical_basis ! j ∈ set (canonical_basis::'a ell2 list)"
using j_bound by auto
have p1: "enum_class.enum ! enum_idx i = i"
using enum_idx_correct by blast
moreover have p2: "(canonical_basis::'a ell2 list) ! t = ket ((enum_class.enum::'a list) ! t)"
if "t < length (enum_class.enum::'a list)"
for t
unfolding canonical_basis_ell2_def
using that by auto
moreover have p3: "enum_idx i < length (enum_class.enum::'a list)"
proof-
have "set (enum_class.enum::'a list) = UNIV"
using UNIV_enum by blast
hence "i ∈ set (enum_class.enum::'a list)"
by blast
thus ?thesis
unfolding enum_idx_def
by (metis index_of_bound length_greater_0_conv length_pos_if_in_set)
qed
ultimately have p4: "(canonical_basis::'a ell2 list) ! (enum_idx i) = ket i"
by auto
have "enum_idx i < length (enum_class.enum::'a list)"
using p3
by auto
moreover have "length (enum_class.enum::'a list) = dim_vec (vec_of_basis_enum (ket i))"
unfolding vec_of_basis_enum_def canonical_basis_ell2_def
using dim_vec_of_basis_enum'[where v = "ket i"]
unfolding canonical_basis_ell2_def by simp
ultimately have enum_i_dim_vec: "enum_idx i < dim_vec (unit_vec (CARD('a)) (enum_idx i))"
using ‹dim_vec (vec_of_basis_enum (ket i)) = dim_vec (unit_vec (CARD('a)) (enum_idx i))› by auto
hence r1: "(unit_vec (CARD('a)) (enum_idx i)) $ j
= (if enum_idx i = j then 1 else 0)"
using ‹dim_vec (vec_of_basis_enum (ket i)) = dim_vec (unit_vec (CARD('a)) (enum_idx i))› that by auto
moreover have "vec_of_basis_enum (ket i) $ j = (if enum_idx i = j then 1 else 0)"
proof(cases "enum_idx i = j")
case True
have "crepresentation (set (canonical_basis::'a ell2 list))
((canonical_basis::'a ell2 list) ! j) ((canonical_basis::'a ell2 list) ! j) = 1"
using y1 y2 complex_vector.representation_basis[where
basis = "set (canonical_basis::'a ell2 list)"
and b = "(canonical_basis::'a ell2 list) ! j"]
by smt
hence "vec_of_basis_enum ((canonical_basis::'a ell2 list) ! j) $ j = 1"
unfolding vec_of_basis_enum_def
by (metis j_bound nth_map vec_of_list_index)
hence "vec_of_basis_enum ((canonical_basis::'a ell2 list) ! (enum_idx i))
$ enum_idx i = 1"
using True by simp
hence "vec_of_basis_enum (ket i) $ enum_idx i = 1"
using p4
by simp
thus ?thesis using True unfolding vec_of_basis_enum_def by auto
next
case False
have "crepresentation (set (canonical_basis::'a ell2 list))
((canonical_basis::'a ell2 list) ! (enum_idx i)) ((canonical_basis::'a ell2 list) ! j) = 0"
using y1 y2 complex_vector.representation_basis[where
basis = "set (canonical_basis::'a ell2 list)"
and b = "(canonical_basis::'a ell2 list) ! j"]
by (metis (mono_tags, hide_lams) False enum_i_dim_vec basis_enum_of_vec_inverse basis_enum_of_vec_unit_vec canonical_basis_length_ell2 index_unit_vec(3) j_bound list_of_vec_index list_vec nth_map r1 vec_of_basis_enum_def)
hence "vec_of_basis_enum ((canonical_basis::'a ell2 list) ! (enum_idx i)) $ j = 0"
unfolding vec_of_basis_enum_def by (smt j_bound nth_map vec_of_list_index)
hence "vec_of_basis_enum ((canonical_basis::'a ell2 list) ! (enum_idx i)) $ j = 0"
by auto
hence "vec_of_basis_enum (ket i) $ j = 0"
using p4
by simp
thus ?thesis using False unfolding vec_of_basis_enum_def by simp
qed
ultimately show ?thesis by auto
qed
ultimately show ?thesis
using Matrix.eq_vecI
by auto
qed
lemma vec_of_basis_enum_zero:
defines "nA ≡ length (canonical_basis :: 'a::basis_enum list)"
shows "vec_of_basis_enum (0::'a) = 0⇩v nA"
by (metis assms carrier_vecI dim_vec_of_basis_enum' minus_cancel_vec right_minus_eq vec_of_basis_enum_minus)
lemma (in complex_vec_space) vec_of_basis_enum_cspan:
fixes X :: "'a::basis_enum set"
assumes "length (canonical_basis :: 'a list) = n"
shows "vec_of_basis_enum ` cspan X = span (vec_of_basis_enum ` X)"
proof -
have carrier: "vec_of_basis_enum ` X ⊆ carrier_vec n"
by (metis assms carrier_vecI dim_vec_of_basis_enum' image_subsetI)
have lincomb_sum: "lincomb c A = vec_of_basis_enum (∑b∈B. c' b *⇩C b)"
if B_def: "B = basis_enum_of_vec ` A" and ‹finite A›
and AX: "A ⊆ vec_of_basis_enum ` X" and c'_def: "⋀b. c' b = c (vec_of_basis_enum b)"
for c c' A and B::"'a set"
unfolding B_def using ‹finite A› AX
proof induction
case empty
then show ?case
by (simp add: assms vec_of_basis_enum_zero)
next
case (insert x F)
then have IH: "lincomb c F = vec_of_basis_enum (∑b∈basis_enum_of_vec ` F. c' b *⇩C b)"
(is "_ = ?sum")
by simp
have xx: "vec_of_basis_enum (basis_enum_of_vec x :: 'a) = x"
apply (rule basis_enum_of_vec_inverse)
using assms carrier carrier_vecD insert.prems by auto
have "lincomb c (insert x F) = c x ⋅⇩v x + lincomb c F"
apply (rule lincomb_insert2)
using insert.hyps insert.prems carrier by auto
also have "c x ⋅⇩v x = vec_of_basis_enum (c' (basis_enum_of_vec x) *⇩C (basis_enum_of_vec x :: 'a))"
by (simp add: xx vec_of_basis_enum_scaleC c'_def)
also note IH
also have
"vec_of_basis_enum (c' (basis_enum_of_vec x) *⇩C (basis_enum_of_vec x :: 'a)) + ?sum
= vec_of_basis_enum (∑b∈basis_enum_of_vec ` insert x F. c' b *⇩C b)"
apply simp apply (rule sym)
apply (subst sum.insert)
using ‹finite F› ‹x ∉ F› dim_vec_of_basis_enum' insert.prems
vec_of_basis_enum_add c'_def by auto
finally show ?case
by -
qed
show ?thesis
proof auto
fix x assume "x ∈ local.span (vec_of_basis_enum ` X)"
then obtain c A where xA: "x = lincomb c A" and "finite A" and AX: "A ⊆ vec_of_basis_enum ` X"
unfolding span_def by auto
define B::"'a set" and c' where "B = basis_enum_of_vec ` A"
and "c' b = c (vec_of_basis_enum b)" for b::'a
note xA
also have "lincomb c A = vec_of_basis_enum (∑b∈B. c' b *⇩C b)"
using B_def ‹finite A› AX c'_def by (rule lincomb_sum)
also have "… ∈ vec_of_basis_enum ` cspan X"
unfolding complex_vector.span_explicit
apply (rule imageI) apply (rule CollectI)
apply (rule exI) apply (rule exI)
using ‹finite A› AX by (auto simp: B_def)
finally show "x ∈ vec_of_basis_enum ` cspan X"
by -
next
fix x assume "x ∈ cspan X"
then obtain c' B where x: "x = (∑b∈B. c' b *⇩C b)" and "finite B" and BX: "B ⊆ X"
unfolding complex_vector.span_explicit by auto
define A and c where "A = vec_of_basis_enum ` B"
and "c b = c' (basis_enum_of_vec b)" for b
have "vec_of_basis_enum x = vec_of_basis_enum (∑b∈B. c' b *⇩C b)"
using x by simp
also have "… = lincomb c A"
apply (rule lincomb_sum[symmetric])
unfolding A_def c_def using BX ‹finite B›
by (auto simp: image_image)
also have "… ∈ span (vec_of_basis_enum ` X)"
unfolding span_def apply (rule CollectI)
apply (rule exI, rule exI)
unfolding A_def using ‹finite B› BX by auto
finally show "vec_of_basis_enum x ∈ local.span (vec_of_basis_enum ` X)"
by -
qed
qed
lemma (in complex_vec_space) basis_enum_of_vec_span:
assumes "length (canonical_basis :: 'a list) = n"
assumes "Y ⊆ carrier_vec n"
shows "basis_enum_of_vec ` local.span Y = cspan (basis_enum_of_vec ` Y :: 'a::basis_enum set)"
proof -
define X::"'a set" where "X = basis_enum_of_vec ` Y"
then have "cspan (basis_enum_of_vec ` Y :: 'a set) = basis_enum_of_vec ` vec_of_basis_enum ` cspan X"
by (simp add: image_image)
also have "… = basis_enum_of_vec ` local.span (vec_of_basis_enum ` X)"
apply (subst vec_of_basis_enum_cspan)
using assms by simp_all
also have "vec_of_basis_enum ` X = Y"
unfolding X_def image_image
apply (rule image_cong[where g=id and M=Y and N=Y, simplified])
using assms(1) assms(2) by auto
finally show ?thesis
by simp
qed
lemma vec_of_basis_enum_canonical_basis:
assumes "i < length (canonical_basis :: 'a list)"
shows "vec_of_basis_enum (canonical_basis!i :: 'a)
= unit_vec (length (canonical_basis :: 'a::basis_enum list)) i"
by (metis assms basis_enum_of_vec_inverse basis_enum_of_vec_unit_vec index_unit_vec(3))
lemma vec_of_basis_enum_times:
fixes ψ φ :: "'a::one_dim"
shows "vec_of_basis_enum (ψ * φ)
= vec_of_list [vec_index (vec_of_basis_enum ψ) 0 * vec_index (vec_of_basis_enum φ) 0]"
proof -
have [simp]: ‹crepresentation {1} x 1 = one_dim_iso x› for x :: 'a
apply (subst one_dim_scaleC_1[where x=x, symmetric])
apply (subst complex_vector.representation_scale)
by (auto simp add: complex_vector.span_base complex_vector.representation_basis)
show ?thesis
apply (rule eq_vecI)
by (auto simp: vec_of_basis_enum_def)
qed
lemma vec_of_basis_enum_to_inverse:
fixes ψ :: "'a::one_dim"
shows "vec_of_basis_enum (inverse ψ) = vec_of_list [inverse (vec_index (vec_of_basis_enum ψ) 0)]"
proof -
have [simp]: ‹crepresentation {1} x 1 = one_dim_iso x› for x :: 'a
apply (subst one_dim_scaleC_1[where x=x, symmetric])
apply (subst complex_vector.representation_scale)
by (auto simp add: complex_vector.span_base complex_vector.representation_basis)
show ?thesis
apply (rule eq_vecI)
apply (auto simp: vec_of_basis_enum_def)
by (metis complex_vector.scale_cancel_right one_dim_inverse one_dim_scaleC_1 zero_neq_one)
qed
lemma vec_of_basis_enum_divide:
fixes ψ φ :: "'a::one_dim"
shows "vec_of_basis_enum (ψ / φ)
= vec_of_list [vec_index (vec_of_basis_enum ψ) 0 / vec_index (vec_of_basis_enum φ) 0]"
by (simp add: divide_inverse vec_of_basis_enum_to_inverse vec_of_basis_enum_times)
lemma vec_of_basis_enum_1: "vec_of_basis_enum (1 :: 'a::one_dim) = vec_of_list [1]"
proof -
have [simp]: ‹crepresentation {1} x 1 = one_dim_iso x› for x :: 'a
apply (subst one_dim_scaleC_1[where x=x, symmetric])
apply (subst complex_vector.representation_scale)
by (auto simp add: complex_vector.span_base complex_vector.representation_basis)
show ?thesis
apply (rule eq_vecI)
by (auto simp: vec_of_basis_enum_def)
qed
lemma vec_of_basis_enum_ell2_component:
fixes ψ :: ‹'a::enum ell2›
assumes [simp]: ‹i < CARD('a)›
shows ‹vec_of_basis_enum ψ $ i = Rep_ell2 ψ (Enum.enum ! i)›
proof -
let ?i = ‹Enum.enum ! i›
have ‹Rep_ell2 ψ (Enum.enum ! i) = ⟨ket ?i, ψ⟩›
by (simp add: cinner_ket_left)
also have ‹… = vec_of_basis_enum ψ ∙c vec_of_basis_enum (ket ?i :: 'a ell2)›
by (rule cscalar_prod_vec_of_basis_enum[symmetric])
also have ‹… = vec_of_basis_enum ψ ∙c unit_vec (CARD('a)) i›
by (simp add: vec_of_basis_enum_ket enum_idx_enum)
also have ‹… = vec_of_basis_enum ψ ∙ unit_vec (CARD('a)) i›
by (smt (verit, best) assms carrier_vecI conjugate_conjugate_sprod conjugate_id conjugate_vec_sprod_comm dim_vec_conjugate eq_vecI index_unit_vec(3) scalar_prod_left_unit vec_index_conjugate)
also have ‹… = vec_of_basis_enum ψ $ i›
by simp
finally show ?thesis
by simp
qed
lemma corthogonal_vec_of_basis_enum:
fixes S :: "'a::onb_enum list"
shows "corthogonal (map vec_of_basis_enum S) ⟷ is_ortho_set (set S) ∧ distinct S"
proof auto
assume assm: ‹corthogonal (map vec_of_basis_enum S)›
then show ‹is_ortho_set (set S)›
by (smt (verit, ccfv_SIG) cinner_eq_zero_iff corthogonal_def cscalar_prod_vec_of_basis_enum in_set_conv_nth is_ortho_set_def length_map nth_map)
show ‹distinct S›
using assm corthogonal_distinct distinct_map by blast
next
assume ‹is_ortho_set (set S)› and ‹distinct S›
then show ‹corthogonal (map vec_of_basis_enum S)›
by (smt (verit, ccfv_threshold) cinner_eq_zero_iff corthogonalI cscalar_prod_vec_of_basis_enum is_ortho_set_def length_map length_map nth_eq_iff_index_eq nth_map nth_map nth_mem nth_mem)
qed
subsection ‹Isomorphism between bounded linear functions and matrices›
text ‹We define the canonical isomorphism between \<^typ>‹'a::basis_enum ⇒⇩C⇩L'b::basis_enum›
and the complex \<^term>‹n*m›-matrices (where n,m are the dimensions of \<^typ>‹'a›, \<^typ>‹'b›,
respectively). This is possible if \<^typ>‹'a›, \<^typ>‹'b› are of class \<^class>‹basis_enum›
since that class fixes a finite canonical basis. Matrices are represented using
the \<^typ>‹complex mat› type from \<^session>‹Jordan_Normal_Form›.
(The isomorphism will be called \<^term>‹mat_of_cblinfun› below.)›
definition mat_of_cblinfun :: ‹'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L'b::{basis_enum,complex_normed_vector} ⇒ complex mat› where
‹mat_of_cblinfun f =
mat (length (canonical_basis :: 'b list)) (length (canonical_basis :: 'a list)) (
λ (i, j). crepresentation (set (canonical_basis::'b list)) (f *⇩V ((canonical_basis::'a list)!j)) ((canonical_basis::'b list)!i))›
for f
lift_definition cblinfun_of_mat :: ‹complex mat ⇒ 'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L'b::{basis_enum,complex_normed_vector}› is
‹λM. λv. (if M∈carrier_mat (length (canonical_basis :: 'b list)) (length (canonical_basis :: 'a list))
then basis_enum_of_vec (M *⇩v vec_of_basis_enum v)
else 0)›
proof
fix M :: "complex mat"
define m where "m = length (canonical_basis :: 'b list)"
define n where "n = length (canonical_basis :: 'a list)"
define f::"complex mat ⇒ 'a ⇒ 'b"
where "f M v = (if M∈carrier_mat m n
then basis_enum_of_vec (M *⇩v vec_of_basis_enum (v::'a))
else (0::'b))"
for M::"complex mat" and v::'a
show add: ‹f M (b1 + b2) = f M b1 + f M b2› for b1 b2
apply (auto simp: f_def)
by (metis (mono_tags, lifting) carrier_matD(1) carrier_vec_dim_vec dim_mult_mat_vec dim_vec_of_basis_enum' m_def mult_add_distrib_mat_vec n_def basis_enum_of_vec_add vec_of_basis_enum_add)
show scale: ‹f M (c *⇩C b) = c *⇩C f M b› for c b
apply (auto simp: f_def)
by (metis carrier_matD(1) carrier_vec_dim_vec dim_mult_mat_vec dim_vec_of_basis_enum' m_def mult_mat_vec n_def basis_enum_of_vec_mult vec_of_basis_enum_scaleC)
from add scale have ‹clinear (f M)›
by (simp add: clinear_iff)
show ‹∃K. ∀b. norm (f M b) ≤ norm b * K›
proof (cases "M∈carrier_mat m n")
case True
have f_def': "f M v = basis_enum_of_vec (M *⇩v (vec_of_basis_enum v))" for v
using True f_def
m_def n_def by auto
have M_carrier_mat:
"M ∈ carrier_mat m n"
by (simp add: True)
have "bounded_clinear (f M)"
apply (rule bounded_clinear_finite_dim) using ‹clinear (f M)› by auto
thus ?thesis
by (simp add: bounded_clinear.bounded)
next
case False
thus ?thesis
unfolding f_def m_def n_def
by (metis (full_types) order_refl mult_eq_0_iff norm_eq_zero)
qed
qed
lemma mat_of_cblinfun_ell2_carrier[simp]: ‹mat_of_cblinfun (a::'a::enum ell2 ⇒⇩C⇩L 'b::enum ell2) ∈ carrier_mat CARD('b) CARD('a)›
by (simp add: mat_of_cblinfun_def)
lemma dim_row_mat_of_cblinfun[simp]: ‹dim_row (mat_of_cblinfun (a::'a::enum ell2 ⇒⇩C⇩L 'b::enum ell2)) = CARD('b)›
by (simp add: mat_of_cblinfun_def)
lemma dim_col_mat_of_cblinfun[simp]: ‹dim_col (mat_of_cblinfun (a::'a::enum ell2 ⇒⇩C⇩L 'b::enum ell2)) = CARD('a)›
by (simp add: mat_of_cblinfun_def)
lemma mat_of_cblinfun_cblinfun_apply:
"vec_of_basis_enum (F *⇩V u) = mat_of_cblinfun F *⇩v vec_of_basis_enum u"
for F::"'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'b::{basis_enum,complex_normed_vector}" and u::'a
proof (rule eq_vecI)
show ‹dim_vec (vec_of_basis_enum (F *⇩V u)) = dim_vec (mat_of_cblinfun F *⇩v vec_of_basis_enum u)›
by (simp add: dim_vec_of_basis_enum' mat_of_cblinfun_def)
next
fix i
define BasisA where "BasisA = (canonical_basis::'a list)"
define BasisB where "BasisB = (canonical_basis::'b list)"
define nA where "nA = length (canonical_basis :: 'a list)"
define nB where "nB = length (canonical_basis :: 'b list)"
assume ‹i < dim_vec (mat_of_cblinfun F *⇩v vec_of_basis_enum u)›
then have [simp]: ‹i < nB›
by (simp add: mat_of_cblinfun_def nB_def)
define v where ‹v = BasisB ! i›
have [simp]: ‹dim_row (mat_of_cblinfun F) = nB›
by (simp add: mat_of_cblinfun_def nB_def)
have [simp]: ‹length BasisB = nB›
by (simp add: nB_def BasisB_def)
have [simp]: ‹length BasisA = nA›
using BasisA_def nA_def by auto
have [simp]: ‹cindependent (set BasisA)›
using BasisA_def is_cindependent_set by auto
have [simp]: ‹cindependent (set BasisB)›
using BasisB_def is_cindependent_set by blast
have [simp]: ‹cspan (set BasisB) = UNIV›
by (simp add: BasisB_def is_generator_set)
have [simp]: ‹cspan (set BasisA) = UNIV›
by (simp add: BasisA_def is_generator_set)
have ‹(mat_of_cblinfun F *⇩v vec_of_basis_enum u) $ i =
(∑j = 0..<nA. row (mat_of_cblinfun F) i $ j * crepresentation (set BasisA) u (vec_of_list BasisA $ j))›
by (auto simp: vec_of_basis_enum_def scalar_prod_def simp flip: BasisA_def)
also have ‹… = (∑j = 0..<nA. crepresentation (set BasisB) (F *⇩V BasisA ! j) v
* crepresentation (set BasisA) u (BasisA ! j))›
apply (rule sum.cong[OF refl])
by (auto simp: vec_of_list_index mat_of_cblinfun_def scalar_prod_def v_def simp flip: BasisA_def BasisB_def)
also have ‹… = crepresentation (set BasisB) (F *⇩V u) v› (is ‹(∑j=_..<_. ?lhs v j) = _›)
proof (rule complex_vector.representation_eqI[symmetric, THEN fun_cong])
show ‹cindependent (set BasisB)› ‹F *⇩V u ∈ cspan (set BasisB)›
by simp_all
show only_basis: ‹(∑j = 0..<nA. ?lhs b j) ≠ 0 ⟹ b ∈ set BasisB› for b
by (metis (mono_tags, lifting) complex_vector.representation_ne_zero mult_not_zero sum.not_neutral_contains_not_neutral)
then show ‹finite {b. (∑j = 0..<nA. ?lhs b j) ≠ 0}›
by (smt (z3) List.finite_set finite_subset mem_Collect_eq subsetI)
have ‹(∑b | (∑j = 0..<nA. ?lhs b j) ≠ 0. (∑j = 0..<nA. ?lhs b j) *⇩C b) =
(∑b∈set BasisB. (∑j = 0..<nA. ?lhs b j) *⇩C b)›
apply (rule sum.mono_neutral_left)
using only_basis by auto
also have ‹… = (∑b∈set BasisB. (∑a∈set BasisA. crepresentation (set BasisB) (F *⇩V a) b * crepresentation (set BasisA) u a) *⇩C b)›
apply (subst sum.reindex_bij_betw[where h=‹nth BasisA› and T=‹set BasisA›])
apply (metis BasisA_def ‹length BasisA = nA› atLeast0LessThan bij_betw_nth distinct_canonical_basis)
by simp
also have ‹… = (∑a∈set BasisA. crepresentation (set BasisA) u a *⇩C (∑b∈set BasisB. crepresentation (set BasisB) (F *⇩V a) b *⇩C b))›
apply (simp add: scaleC_sum_left scaleC_sum_right)
apply (subst sum.swap)
by (metis (no_types, lifting) mult.commute sum.cong)
also have ‹… = (∑a∈set BasisA. crepresentation (set BasisA) u a *⇩C (F *⇩V a))›
apply (subst complex_vector.sum_representation_eq)
by auto
also have ‹… = F *⇩V (∑a∈set BasisA. crepresentation (set BasisA) u a *⇩C a)›
by (simp flip: cblinfun.scaleC_right cblinfun.sum_right)
also have ‹… = F *⇩V u›
apply (subst complex_vector.sum_representation_eq)
by auto
finally show ‹(∑b | (∑j = 0..<nA. ?lhs b j) ≠ 0. (∑j = 0..<nA. ?lhs b j) *⇩C b) = F *⇩V u›
by auto
qed
also have ‹crepresentation (set BasisB) (F *⇩V u) v = vec_of_basis_enum (F *⇩V u) $ i›
by (auto simp: vec_of_list_index vec_of_basis_enum_def v_def simp flip: BasisB_def)
finally show ‹vec_of_basis_enum (F *⇩V u) $ i = (mat_of_cblinfun F *⇩v vec_of_basis_enum u) $ i›
by simp
qed
lemma basis_enum_of_vec_cblinfun_apply:
fixes M :: "complex mat"
defines "nA ≡ length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
and "nB ≡ length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
assumes "M ∈ carrier_mat nB nA" and "dim_vec x = nA"
shows "basis_enum_of_vec (M *⇩v x) = (cblinfun_of_mat M :: 'a ⇒⇩C⇩L 'b) *⇩V basis_enum_of_vec x"
by (metis assms basis_enum_of_vec_inverse cblinfun_of_mat.rep_eq)
lemma mat_of_cblinfun_inverse:
"cblinfun_of_mat (mat_of_cblinfun B) = B"
for B::"'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'b::{basis_enum,complex_normed_vector}"
proof (rule cblinfun_eqI)
fix x :: 'a define y where ‹y = vec_of_basis_enum x›
then have ‹cblinfun_of_mat (mat_of_cblinfun B) *⇩V x = ((cblinfun_of_mat (mat_of_cblinfun B) :: 'a⇒⇩C⇩L'b) *⇩V basis_enum_of_vec y)›
by simp
also have ‹… = basis_enum_of_vec (mat_of_cblinfun B *⇩v vec_of_basis_enum (basis_enum_of_vec y :: 'a))›
apply (transfer fixing: B)
by (simp add: mat_of_cblinfun_def)
also have ‹… = basis_enum_of_vec (vec_of_basis_enum (B *⇩V x))›
by (simp add: mat_of_cblinfun_cblinfun_apply y_def)
also have ‹… = B *⇩V x›
by simp
finally show ‹cblinfun_of_mat (mat_of_cblinfun B) *⇩V x = B *⇩V x›
by -
qed
lemma mat_of_cblinfun_inj: "inj mat_of_cblinfun"
by (metis inj_on_def mat_of_cblinfun_inverse)
lemma cblinfun_of_mat_inverse:
fixes M::"complex mat"
defines "nA ≡ length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
and "nB ≡ length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
assumes "M ∈ carrier_mat nB nA"
shows "mat_of_cblinfun (cblinfun_of_mat M :: 'a ⇒⇩C⇩L 'b) = M"
by (smt (verit) assms(3) basis_enum_of_vec_inverse carrier_matD(1) carrier_vecD cblinfun_of_mat.rep_eq dim_mult_mat_vec eq_mat_on_vecI mat_carrier mat_of_cblinfun_def mat_of_cblinfun_cblinfun_apply nA_def nB_def)
lemma cblinfun_of_mat_inj: "inj_on (cblinfun_of_mat::complex mat ⇒ 'a ⇒⇩C⇩L 'b)
(carrier_mat (length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list))
(length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)))"
using cblinfun_of_mat_inverse
by (metis inj_onI)
lemma cblinfun_eq_mat_of_cblinfunI:
assumes "mat_of_cblinfun a = mat_of_cblinfun b"
shows "a = b"
by (metis assms mat_of_cblinfun_inverse)
subsection ‹Matrix operations›
lemma cblinfun_of_mat_plus:
defines "nA ≡ length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
and "nB ≡ length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
assumes [simp,intro]: "M ∈ carrier_mat nB nA" and [simp,intro]: "N ∈ carrier_mat nB nA"
shows "(cblinfun_of_mat (M + N) :: 'a ⇒⇩C⇩L 'b) = ((cblinfun_of_mat M + cblinfun_of_mat N))"
proof -
have [simp]: ‹vec_of_basis_enum (v :: 'a) ∈ carrier_vec nA› for v
by (auto simp add: carrier_dim_vec dim_vec_of_basis_enum' nA_def)
have [simp]: ‹dim_row M = nB› ‹dim_row N = nB›
using carrier_matD(1) by auto
show ?thesis
apply (transfer fixing: M N)
by (auto intro!: ext simp add: add_mult_distrib_mat_vec nA_def[symmetric] nB_def[symmetric]
add_mult_distrib_mat_vec[where nr=nB and nc=nA] basis_enum_of_vec_add)
qed
lemma mat_of_cblinfun_zero:
"mat_of_cblinfun (0 :: ('a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'b::{basis_enum,complex_normed_vector}))
= 0⇩m (length (canonical_basis :: 'b list)) (length (canonical_basis :: 'a list))"
unfolding mat_of_cblinfun_def
by (auto simp: complex_vector.representation_zero)
lemma mat_of_cblinfun_plus:
"mat_of_cblinfun (F + G) = mat_of_cblinfun F + mat_of_cblinfun G"
for F G::"'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L'b::{basis_enum,complex_normed_vector}"
by (auto simp add: mat_of_cblinfun_def cblinfun.add_left complex_vector.representation_add)
lemma mat_of_cblinfun_id:
"mat_of_cblinfun (id_cblinfun :: ('a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L'a)) = 1⇩m (length (canonical_basis :: 'a list))"
apply (rule eq_matI)
by (auto simp: mat_of_cblinfun_def complex_vector.representation_basis is_cindependent_set nth_eq_iff_index_eq)
lemma mat_of_cblinfun_1:
"mat_of_cblinfun (1 :: ('a::one_dim ⇒⇩C⇩L'b::one_dim)) = 1⇩m 1"
apply (rule eq_matI)
by (auto simp: mat_of_cblinfun_def complex_vector.representation_basis nth_eq_iff_index_eq)
lemma mat_of_cblinfun_uminus:
"mat_of_cblinfun (- M) = - mat_of_cblinfun M"
for M::"'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L'b::{basis_enum,complex_normed_vector}"
proof-
define nA where "nA = length (canonical_basis :: 'a list)"
define nB where "nB = length (canonical_basis :: 'b list)"
have M1: "mat_of_cblinfun M ∈ carrier_mat nB nA"
unfolding nB_def nA_def
by (metis add.right_neutral add_carrier_mat mat_of_cblinfun_plus mat_of_cblinfun_zero nA_def
nB_def zero_carrier_mat)
have M2: "mat_of_cblinfun (-M) ∈ carrier_mat nB nA"
by (metis add_carrier_mat mat_of_cblinfun_plus mat_of_cblinfun_zero diff_0 nA_def nB_def
uminus_add_conv_diff zero_carrier_mat)
have "mat_of_cblinfun (M - M) = 0⇩m nB nA"
unfolding nA_def nB_def
by (simp add: mat_of_cblinfun_zero)
moreover have "mat_of_cblinfun (M - M) = mat_of_cblinfun M + mat_of_cblinfun (- M)"
by (metis mat_of_cblinfun_plus pth_2)
ultimately have "mat_of_cblinfun M + mat_of_cblinfun (- M) = 0⇩m nB nA"
by simp
thus ?thesis
using M1 M2
by (smt add_uminus_minus_mat assoc_add_mat comm_add_mat left_add_zero_mat minus_r_inv_mat
uminus_carrier_mat)
qed
lemma mat_of_cblinfun_minus:
"mat_of_cblinfun (M - N) = mat_of_cblinfun M - mat_of_cblinfun N"
for M::"'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'b::{basis_enum,complex_normed_vector}" and N::"'a ⇒⇩C⇩L'b"
by (smt (z3) add_uminus_minus_mat mat_of_cblinfun_uminus mat_carrier mat_of_cblinfun_def mat_of_cblinfun_plus pth_2)
lemma cblinfun_of_mat_uminus:
defines "nA ≡ length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
and "nB ≡ length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
assumes "M ∈ carrier_mat nB nA"
shows "(cblinfun_of_mat (-M) :: 'a ⇒⇩C⇩L 'b) = - cblinfun_of_mat M"
by (smt assms add.group_axioms add.right_neutral add_minus_cancel add_uminus_minus_mat
cblinfun_of_mat_plus group.inverse_inverse mat_of_cblinfun_inverse mat_of_cblinfun_zero
minus_r_inv_mat uminus_carrier_mat)
lemma cblinfun_of_mat_minus:
fixes M::"complex mat"
defines "nA ≡ length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
and "nB ≡ length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
assumes "M ∈ carrier_mat nB nA" and "N ∈ carrier_mat nB nA"
shows "(cblinfun_of_mat (M - N) :: 'a ⇒⇩C⇩L 'b) = cblinfun_of_mat M - cblinfun_of_mat N"
by (metis assms add_uminus_minus_mat cblinfun_of_mat_plus cblinfun_of_mat_uminus pth_2 uminus_carrier_mat)
lemma cblinfun_of_mat_times:
fixes M N ::"complex mat"
defines "nA ≡ length (canonical_basis :: 'a::{basis_enum,complex_normed_vector} list)"
and "nB ≡ length (canonical_basis :: 'b::{basis_enum,complex_normed_vector} list)"
and "nC ≡ length (canonical_basis :: 'c::{basis_enum,complex_normed_vector} list)"
assumes a1: "M ∈ carrier_mat nC nB" and a2: "N ∈ carrier_mat nB nA"
shows "cblinfun_of_mat (M * N) = ((cblinfun_of_mat M)::'b ⇒⇩C⇩L'c) o⇩C⇩L ((cblinfun_of_mat N)::'a ⇒⇩C⇩L'b)"
proof -
have b1: "((cblinfun_of_mat M)::'b ⇒⇩C⇩L'c) v = basis_enum_of_vec (M *⇩v vec_of_basis_enum v)"
for v
by (metis assms(4) cblinfun_of_mat.rep_eq nB_def nC_def)
have b2: "((cblinfun_of_mat N)::'a ⇒⇩C⇩L'b) v = basis_enum_of_vec (N *⇩v vec_of_basis_enum v)"
for v
by (metis assms(5) cblinfun_of_mat.rep_eq nA_def nB_def)
have b3: "((cblinfun_of_mat (M * N))::'a ⇒⇩C⇩L'c) v
= basis_enum_of_vec ((M * N) *⇩v vec_of_basis_enum v)"
for v
by (metis assms(4) assms(5) cblinfun_of_mat.rep_eq mult_carrier_mat nA_def nC_def)
have "(basis_enum_of_vec ((M * N) *⇩v vec_of_basis_enum v)::'c)
= (basis_enum_of_vec (M *⇩v ( vec_of_basis_enum ( (basis_enum_of_vec (N *⇩v vec_of_basis_enum v))::'b ))))"
for v::'a
proof-
have c1: "vec_of_basis_enum (basis_enum_of_vec x :: 'b) = x"
if "dim_vec x = nB"
for x::"complex vec"
using that unfolding nB_def
by simp
have c2: "vec_of_basis_enum v ∈ carrier_vec nA"
by (metis (mono_tags, hide_lams) add.commute carrier_vec_dim_vec index_add_vec(2)
index_zero_vec(2) nA_def vec_of_basis_enum_add basis_enum_of_vec_inverse)
have "(M * N) *⇩v vec_of_basis_enum v = M *⇩v (N *⇩v vec_of_basis_enum v)"
using Matrix.assoc_mult_mat_vec a1 a2 c2 by blast
hence "(basis_enum_of_vec ((M * N) *⇩v vec_of_basis_enum v)::'c)
= (basis_enum_of_vec (M *⇩v (N *⇩v vec_of_basis_enum v))::'c)"
by simp
also have "… =
(basis_enum_of_vec (M *⇩v ( vec_of_basis_enum ( (basis_enum_of_vec (N *⇩v vec_of_basis_enum v))::'b ))))"
using c1 a2 by auto
finally show ?thesis by simp
qed
thus ?thesis using b1 b2 b3
by (simp add: cblinfun_eqI scaleC_cblinfun.rep_eq)
qed
lemma cblinfun_of_mat_adjoint:
defines "nA ≡ length (canonical_basis :: 'a::onb_enum list)"
and "nB ≡ length (canonical_basis :: 'b::onb_enum list)"
fixes M:: "complex mat"
assumes "M ∈ carrier_mat nB nA"
shows "((cblinfun_of_mat (mat_adjoint M)) :: 'b ⇒⇩C⇩L 'a) = (cblinfun_of_mat M)*"
proof (rule adjoint_eqI)
show "⟨cblinfun_of_mat (mat_adjoint M) *⇩V x, y⟩ =
⟨x, cblinfun_of_mat M *⇩V y⟩"
for x::'b and y::'a
proof-
define u where "u = vec_of_basis_enum x"
define v where "v = vec_of_basis_enum y"
have c1: "vec_of_basis_enum ((cblinfun_of_mat (mat_adjoint M) *⇩V x)::'a) = (mat_adjoint M) *⇩v u"
unfolding u_def
by (metis (mono_tags, lifting) assms(3) cblinfun_of_mat_inverse map_carrier_mat mat_adjoint_def' mat_of_cblinfun_cblinfun_apply nA_def nB_def transpose_carrier_mat)
have c2: "(vec_of_basis_enum ((cblinfun_of_mat M *⇩V y)::'b))
= M *⇩v v"
by (metis assms(3) cblinfun_of_mat_inverse mat_of_cblinfun_cblinfun_apply nA_def nB_def v_def)
have c3: "dim_vec v = nA"
unfolding v_def nA_def vec_of_basis_enum_def
by (simp add:)
have c4: "dim_vec u = nB"
unfolding u_def nB_def vec_of_basis_enum_def
by (simp add:)
have "v ∙c ((mat_adjoint M) *⇩v u) = (M *⇩v v) ∙c u"
using c3 c4 cscalar_prod_adjoint assms(3) by blast
hence "v ∙c (vec_of_basis_enum ((cblinfun_of_mat (mat_adjoint M) *⇩V x)::'a))
= (vec_of_basis_enum ((cblinfun_of_mat M *⇩V y)::'b)) ∙c u"
using c1 c2 by simp
thus "⟨cblinfun_of_mat (mat_adjoint M) *⇩V x, y⟩ =
⟨x, cblinfun_of_mat M *⇩V y⟩"
unfolding u_def v_def
by (simp add: cscalar_prod_vec_of_basis_enum)
qed
qed
lemma mat_of_cblinfun_classical_operator:
fixes f::"'a::enum ⇒ 'b::enum option"
shows "mat_of_cblinfun (classical_operator f) = mat (CARD('b)) (CARD('a))
(λ(r,c). if f (Enum.enum!c) = Some (Enum.enum!r) then 1 else 0)"
proof -
define nA where "nA = CARD('a)"
define nB where "nB = CARD('b)"
define BasisA where "BasisA = (canonical_basis::'a ell2 list)"
define BasisB where "BasisB = (canonical_basis::'b ell2 list)"
have "mat_of_cblinfun (classical_operator f) ∈ carrier_mat nB nA"
unfolding nA_def nB_def by simp
moreover have "nA = CARD ('a)"
unfolding nA_def
by (simp add:)
moreover have "nB = CARD ('b)"
unfolding nB_def
by (simp add:)
ultimately have "mat_of_cblinfun (classical_operator f) ∈ carrier_mat (CARD('b)) (CARD('a))"
unfolding nA_def nB_def
by simp
moreover have "(mat_of_cblinfun (classical_operator f))$$(r,c)
= (mat (CARD('b)) (CARD('a))
(λ(r,c). if f (Enum.enum!c) = Some (Enum.enum!r) then 1 else 0))$$(r,c)"
if a1: "r < CARD('b)" and a2: "c < CARD('a)"
for r c
proof-
have "CARD('a) = length (enum_class.enum::'a list)"
using card_UNIV_length_enum[where 'a = 'a] .
hence x1: "BasisA!c = ket ((Enum.enum::'a list)!c)"
unfolding BasisA_def using a2 canonical_basis_ell2_def
nth_map[where n = c and xs = "Enum.enum::'a list" and f = ket] by metis
have cardb: "CARD('b) = length (enum_class.enum::'b list)"
using card_UNIV_length_enum[where 'a = 'b] .
hence x2: "BasisB!r = ket ((Enum.enum::'b list)!r)"
unfolding BasisB_def using a1 canonical_basis_ell2_def
nth_map[where n = r and xs = "Enum.enum::'b list" and f = ket] by metis
have "inj (map (ket::'b ⇒_))"
by (meson injI ket_injective list.inj_map)
hence "length (Enum.enum::'b list) = length (map (ket::'b ⇒_) (Enum.enum::'b list))"
by simp
hence lengthBasisB: "CARD('b) = length BasisB"
unfolding BasisB_def canonical_basis_ell2_def using cardb
by smt
have v1: "(mat_of_cblinfun (classical_operator f))$$(r,c) = 0"
if c1: "f (Enum.enum!c) = None"
proof-
have "(classical_operator f) *⇩V ket (Enum.enum!c)
= (case f (Enum.enum!c) of None ⇒ 0 | Some i ⇒ ket i)"
using classical_operator_ket_finite .
also have "… = 0"
using c1 by simp
finally have "(classical_operator f) *⇩V ket (Enum.enum!c) = 0" .
hence *: "(classical_operator f) *⇩V BasisA!c = 0"
using x1 by simp
hence "⟨BasisB!r, (classical_operator f) *⇩V BasisA!c⟩ = 0"
by simp
thus ?thesis
unfolding mat_of_cblinfun_def BasisA_def BasisB_def
by (smt (verit, del_insts) BasisA_def * a1 a2 canonical_basis_length_ell2 complex_vector.representation_zero index_mat(1) old.prod.case)
qed
have v2: "(mat_of_cblinfun (classical_operator f))$$(r,c) = 0"
if c1: "f (Enum.enum!c) = Some (Enum.enum!r')" and c2: "r≠r'"
and c3: "r' < CARD('b)"
for r'
proof-
have x3: "BasisB!r' = ket ((Enum.enum::'b list)!r')"
unfolding BasisB_def using cardb c3 canonical_basis_ell2_def
nth_map[where n = r' and xs = "Enum.enum::'b list" and f = ket]
by smt
have "distinct BasisB"
unfolding BasisB_def
by simp
moreover have "r < length BasisB"
using a1 lengthBasisB by simp
moreover have "r' < length BasisB"
using c3 lengthBasisB by simp
ultimately have h1: "BasisB!r ≠ BasisB!r'"
using nth_eq_iff_index_eq[where xs = BasisB and i = r and j = r'] c2
by blast
have "(classical_operator f) *⇩V ket (Enum.enum!c)
= (case f (Enum.enum!c) of None ⇒ 0 | Some i ⇒ ket i)"
using classical_operator_ket_finite .
also have "… = ket (Enum.enum!r')"
using c1 by simp
finally have "(classical_operator f) *⇩V ket (Enum.enum!c) = ket (Enum.enum!r')" .
hence *: "(classical_operator f) *⇩V BasisA!c = BasisB!r'"
using x1 x3 by simp
moreover have "⟨BasisB!r, BasisB!r'⟩ = 0"
using h1
using BasisB_def ‹r < length BasisB› ‹r' < length BasisB› is_ortho_set_def is_orthonormal nth_mem
by metis
ultimately have "⟨BasisB!r, (classical_operator f) *⇩V BasisA!c⟩ = 0"
by simp
thus ?thesis
unfolding mat_of_cblinfun_def BasisA_def BasisB_def
by (smt (z3) BasisA_def BasisB_def * ‹r < length BasisB› ‹r' < length BasisB› a2 canonical_basis_length_ell2 case_prod_conv complex_vector.representation_basis h1 index_mat(1) is_cindependent_set nth_mem)
qed
have "(mat_of_cblinfun (classical_operator f))$$(r,c) = 0"
if b1: "f (Enum.enum!c) ≠ Some (Enum.enum!r)"
proof (cases "f (Enum.enum!c) = None")
case True thus ?thesis using v1 by blast
next
case False
hence "∃R. f (Enum.enum!c) = Some R"
apply (induction "f (Enum.enum!c)")
apply simp
by simp
then obtain R where R0: "f (Enum.enum!c) = Some R"
by blast
have "R ∈ set (Enum.enum::'b list)"
using UNIV_enum by blast
hence "∃r'. R = (Enum.enum::'b list)!r' ∧ r' < length (Enum.enum::'b list)"
by (metis in_set_conv_nth)
then obtain r' where u1: "R = (Enum.enum::'b list)!r'"
and u2: "r' < length (Enum.enum::'b list)"
by blast
have R1: "f (Enum.enum!c) = Some (Enum.enum!r')"
using R0 u1 by blast
have "Some ((Enum.enum::'b list)!r') ≠ Some ((Enum.enum::'b list)!r)"
proof(rule classical)
assume "¬(Some ((Enum.enum::'b list)!r') ≠ Some ((Enum.enum::'b list)!r))"
hence "Some ((Enum.enum::'b list)!r') = Some ((Enum.enum::'b list)!r)"
by blast
hence "f (Enum.enum!c) = Some ((Enum.enum::'b list)!r)"
using R1 by auto
thus ?thesis
using b1 by blast
qed
hence "((Enum.enum::'b list)!r') ≠ ((Enum.enum::'b list)!r)"
by simp
hence "r' ≠ r"
by blast
moreover have "r' < CARD('b)"
using u2 cardb by simp
ultimately show ?thesis using R1 v2[where r' = r'] by blast
qed
moreover have "(mat_of_cblinfun (classical_operator f))$$(r,c) = 1"
if b1: "f (Enum.enum!c) = Some (Enum.enum!r)"
proof-
have "CARD('b) = length (enum_class.enum::'b list)"
using card_UNIV_length_enum[where 'a = 'b].
hence "length (map (ket::'b⇒_) enum_class.enum) = CARD('b)"
by simp
hence w0: "map (ket::'b⇒_) enum_class.enum ! r = ket (enum_class.enum ! r)"
by (simp add: a1)
have "CARD('a) = length (enum_class.enum::'a list)"
using card_UNIV_length_enum[where 'a = 'a].
hence "length (map (ket::'a⇒_) enum_class.enum) = CARD('a)"
by simp
hence "map (ket::'a⇒_) enum_class.enum ! c = ket (enum_class.enum ! c)"
by (simp add: a2)
hence "(classical_operator f) *⇩V (BasisA!c) = (classical_operator f) *⇩V (ket (Enum.enum!c))"
unfolding BasisA_def canonical_basis_ell2_def by simp
also have "... = (case f (enum_class.enum ! c) of None ⇒ 0 | Some x ⇒ ket x)"
by (rule classical_operator_ket_finite)
also have "… = BasisB!r"
using w0 b1 by (simp add: BasisB_def canonical_basis_ell2_def)
finally have w1: "(classical_operator f) *⇩V (BasisA!c) = BasisB!r"
by simp
have "(mat_of_cblinfun (classical_operator f))$$(r,c)
= ⟨BasisB!r, (classical_operator f) *⇩V (BasisA!c)⟩"
unfolding BasisB_def BasisA_def mat_of_cblinfun_def
using ‹nA = CARD('a)› ‹nB = CARD('b)› a1 a2 nA_def nB_def apply auto
by (metis BasisA_def BasisB_def canonical_basis_length_ell2 cinner_canonical_basis complex_vector.representation_basis is_cindependent_set nth_mem w1)
also have "… = ⟨BasisB!r, BasisB!r⟩"
using w1 by simp
also have "… = 1"
unfolding BasisB_def
using ‹nB = CARD('b)› a1 nB_def
by (simp add: cinner_canonical_basis)
finally show ?thesis by blast
qed
ultimately show ?thesis
by (simp add: a1 a2)
qed
ultimately show ?thesis
apply (rule_tac eq_matI) by auto
qed
lemma mat_of_cblinfun_compose:
"mat_of_cblinfun (F o⇩C⇩L G) = mat_of_cblinfun F * mat_of_cblinfun G"
for F::"'b::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'c::{basis_enum,complex_normed_vector}"
and G::"'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'b"
by (smt (verit, del_insts) cblinfun_of_mat_inverse mat_carrier mat_of_cblinfun_def mat_of_cblinfun_inverse cblinfun_of_mat_times mult_carrier_mat)
lemma mat_of_cblinfun_scaleC:
"mat_of_cblinfun ((a::complex) *⇩C F) = a ⋅⇩m (mat_of_cblinfun F)"
for F :: "'a::{basis_enum,complex_normed_vector} ⇒⇩C⇩L 'b::{basis_enum,complex_normed_vector}"
by (auto simp add: complex_vector.representation_scale mat_of_cblinfun_def)
lemma mat_of_cblinfun_scaleR:
"mat_of_cblinfun ((a::real) *⇩R F) = (complex_of_real a) ⋅⇩m (mat_of_cblinfun F)"
unfolding scaleR_scaleC by (rule mat_of_cblinfun_scaleC)
lemma mat_of_cblinfun_adj:
"mat_of_cblinfun (F*) = mat_adjoint (mat_of_cblinfun F)"
for F :: "'a::onb_enum ⇒⇩C⇩L 'b::onb_enum"
by (metis (no_types, lifting) cblinfun_of_mat_inverse map_carrier_mat mat_adjoint_def' mat_carrier cblinfun_of_mat_adjoint mat_of_cblinfun_def mat_of_cblinfun_inverse transpose_carrier_mat)
lemma mat_of_cblinfun_vector_to_cblinfun:
"mat_of_cblinfun (vector_to_cblinfun ψ)
= mat_of_cols (length (canonical_basis :: 'a list)) [vec_of_basis_enum ψ]"
for ψ::"'a::{basis_enum,complex_normed_vector}"
by (auto simp: mat_of_cols_Cons_index_0 mat_of_cblinfun_def vec_of_basis_enum_def vec_of_list_index)
lemma mat_of_cblinfun_proj:
fixes a::"'a::onb_enum"
defines "d ≡ length (canonical_basis :: 'a list)"
and "norm2 ≡ (vec_of_basis_enum a) ∙c (vec_of_basis_enum a)"
shows "mat_of_cblinfun (proj a) =
1 / norm2 ⋅⇩m (mat_of_cols d [vec_of_basis_enum a]
* mat_of_rows d [conjugate (vec_of_basis_enum a)])" (is ‹_ = ?rhs›)
proof (cases "a = 0")
case False
have norm2: ‹norm2 = (norm a)⇧2›
by (simp add: cscalar_prod_vec_of_basis_enum norm2_def cdot_square_norm[symmetric, simplified])
have [simp]: ‹vec_of_basis_enum a ∈ carrier_vec d›
by (simp add: carrier_vecI d_def dim_vec_of_basis_enum')
have ‹mat_of_cblinfun (proj a) = mat_of_cblinfun (proj (a /⇩R norm a))›
by (metis (mono_tags, hide_lams) ccspan_singleton_scaleC complex_vector.scale_eq_0_iff nonzero_imp_inverse_nonzero norm_eq_zero scaleR_scaleC scale_left_imp_eq)
also have ‹… = mat_of_cblinfun (selfbutter (a /⇩R norm a))›
apply (subst butterfly_eq_proj)
by (auto simp add: False)
also have ‹… = 1/norm2 ⋅⇩m mat_of_cblinfun (selfbutter a)›
apply (simp add: mat_of_cblinfun_scaleC norm2)
by (simp add: inverse_eq_divide power2_eq_square)
also have ‹… = 1 / norm2 ⋅⇩m (mat_of_cblinfun (vector_to_cblinfun a :: complex ⇒⇩C⇩L 'a) * mat_adjoint (mat_of_cblinfun (vector_to_cblinfun a :: complex ⇒⇩C⇩L 'a)))›
by (simp add: butterfly_def mat_of_cblinfun_compose mat_of_cblinfun_adj)
also have ‹… = ?rhs›
by (simp add: mat_of_cblinfun_vector_to_cblinfun mat_adjoint_def flip: d_def)
finally show ?thesis
by -
next
case True
show ?thesis
apply (rule eq_matI)
by (auto simp: True mat_of_cblinfun_zero vec_of_basis_enum_zero scalar_prod_def mat_of_rows_index
simp flip: d_def)
qed
lemma mat_of_cblinfun_ell2_component:
fixes a :: ‹'a::enum ell2 ⇒⇩C⇩L 'b::enum ell2›
assumes [simp]: ‹i < CARD('b)› ‹j < CARD('a)›
shows ‹mat_of_cblinfun a $$ (i,j) = Rep_ell2 (a *⇩V ket (Enum.enum ! j)) (Enum.enum ! i)›
proof -
let ?i = ‹Enum.enum ! i› and ?j = ‹Enum.enum ! j› and ?aj = ‹a *⇩V ket (Enum.enum ! j)›
have ‹Rep_ell2 ?aj (Enum.enum ! i) = vec_of_basis_enum ?aj $ i›
by (rule vec_of_basis_enum_ell2_component[symmetric], simp)
also have ‹… = (mat_of_cblinfun a *⇩v vec_of_basis_enum (ket (enum_class.enum ! j) :: 'a ell2)) $ i›
by (simp add: mat_of_cblinfun_cblinfun_apply)
also have ‹… = (mat_of_cblinfun a *⇩v unit_vec CARD('a) j) $ i›
by (simp add: vec_of_basis_enum_ket enum_idx_enum)
also have ‹… = mat_of_cblinfun a $$ (i, j)›
apply (subst mat_entry_explicit[where m=‹CARD('b)›])
by auto
finally show ?thesis
by auto
qed
lemma mat_of_cblinfun_sandwich:
fixes a :: "(_::onb_enum, _::onb_enum) cblinfun"
shows ‹mat_of_cblinfun (sandwich a *⇩V b) = (let a' = mat_of_cblinfun a in a' * mat_of_cblinfun b * mat_adjoint a')›
by (simp add: mat_of_cblinfun_compose sandwich_apply Let_def mat_of_cblinfun_adj)
subsection ‹Operations on subspaces›
lemma ccspan_gram_schmidt0_invariant:
defines "basis_enum ≡ (basis_enum_of_vec :: _ ⇒ 'a::{basis_enum,complex_normed_vector})"
defines "n ≡ length (canonical_basis :: 'a list)"
assumes "set ws ⊆ carrier_vec n"
shows "ccspan (set (map basis_enum (gram_schmidt0 n ws))) = ccspan (set (map basis_enum ws))"
proof (transfer fixing: n ws basis_enum)
interpret complex_vec_space.
define gs where "gs = gram_schmidt0 n ws"
have "closure (cspan (set (map basis_enum gs)))
= cspan (set (map basis_enum gs))"
apply (rule closure_finite_cspan)
by simp
also have "… = cspan (basis_enum ` set gs)"
by simp
also have "… = basis_enum ` span (set gs)"
unfolding basis_enum_def
apply (rule basis_enum_of_vec_span[symmetric])
using n_def apply simp
by (simp add: assms(3) cof_vec_space.gram_schmidt0_result(1) gs_def)
also have "… = basis_enum ` span (set ws)"
unfolding gs_def
apply (subst gram_schmidt0_result(4)[where ws=ws, symmetric])
using assms by auto
also have "… = cspan (basis_enum ` set ws)"
unfolding basis_enum_def
apply (rule basis_enum_of_vec_span)
using n_def apply simp
by (simp add: assms(3))
also have "… = cspan (set (map basis_enum ws))"
by simp
also have "… = closure (cspan (set (map basis_enum ws)))"
apply (rule closure_finite_cspan[symmetric])
by simp
finally show "closure (cspan (set (map basis_enum gs)))
= closure (cspan (set (map basis_enum ws)))".
qed
definition "is_subspace_of_vec_list n vs ws =
(let ws' = gram_schmidt0 n ws in
∀v∈set vs. adjuster n v ws' = - v)"
lemma ccspan_leq_using_vec:
fixes A B :: "'a::{basis_enum,complex_normed_vector} list"
shows "(ccspan (set A) ≤ ccspan (set B)) ⟷
is_subspace_of_vec_list (length (canonical_basis :: 'a list))
(map vec_of_basis_enum A) (map vec_of_basis_enum B)"
proof -
define d Av Bv Bo
where "d = length (canonical_basis :: 'a list)"
and "Av = map vec_of_basis_enum A"
and "Bv = map vec_of_basis_enum B"
and "Bo = gram_schmidt0 d Bv"
interpret complex_vec_space d.
have Av_carrier: "set Av ⊆ carrier_vec d"
unfolding Av_def apply auto
by (simp add: carrier_vecI d_def dim_vec_of_basis_enum')
have Bv_carrier: "set Bv ⊆ carrier_vec d"
unfolding Bv_def apply auto
by (simp add: carrier_vecI d_def dim_vec_of_basis_enum')
have Bo_carrier: "set Bo ⊆ carrier_vec d"
apply (simp add: Bo_def)
using Bv_carrier by (rule gram_schmidt0_result(1))
have orth_Bo: "corthogonal Bo"
apply (simp add: Bo_def)
using Bv_carrier by (rule gram_schmidt0_result(3))
have distinct_Bo: "distinct Bo"
apply (simp add: Bo_def)
using Bv_carrier by (rule gram_schmidt0_result(2))
have "ccspan (set A) ≤ ccspan (set B) ⟷ cspan (set A) ⊆ cspan (set B)"
apply (transfer fixing: A B)
apply (subst closure_finite_cspan, simp)
by (subst closure_finite_cspan, simp_all)
also have "… ⟷ span (set Av) ⊆ span (set Bv)"
apply (simp add: Av_def Bv_def)
apply (subst vec_of_basis_enum_cspan[symmetric], simp add: d_def)
apply (subst vec_of_basis_enum_cspan[symmetric], simp add: d_def)
by (metis inj_image_subset_iff inj_on_def vec_of_basis_enum_inverse)
also have "… ⟷ span (set Av) ⊆ span (set Bo)"
unfolding Bo_def Av_def Bv_def
apply (subst gram_schmidt0_result(4)[symmetric])
by (simp_all add: carrier_dim_vec d_def dim_vec_of_basis_enum' image_subset_iff)
also have "… ⟷ (∀v∈set Av. adjuster d v Bo = - v)"
proof (intro iffI ballI)
fix v assume "v ∈ set Av" and "span (set Av) ⊆ span (set Bo)"
then have "v ∈ span (set Bo)"
using Av_carrier span_mem by auto
have "adjuster d v Bo + v = 0⇩v d"
apply (rule adjuster_already_in_span)
using Av_carrier ‹v ∈ set Av› Bo_carrier orth_Bo
‹v ∈ span (set Bo)› by simp_all
then show "adjuster d v Bo = - v"
using Av_carrier Bo_carrier ‹v ∈ set Av›
by (metis (no_types, lifting) add.inv_equality adjuster_carrier' local.vec_neg subsetD)
next
fix v
assume adj_minusv: "∀v∈set Av. adjuster d v Bo = - v"
have *: "adjuster d v Bo ∈ span (set Bo)" if "v ∈ set Av" for v
apply (rule adjuster_in_span)
using Bo_carrier that Av_carrier distinct_Bo by auto
have "v ∈ span (set Bo)" if "v ∈ set Av" for v
using *[OF that] adj_minusv[rule_format, OF that]
apply auto
by (metis (no_types, lifting) Av_carrier Bo_carrier adjust_nonzero distinct_Bo subsetD that uminus_l_inv_vec)
then show "span (set Av) ⊆ span (set Bo)"
apply auto
by (meson Bo_carrier in_mono span_subsetI subsetI)
qed
also have "… = is_subspace_of_vec_list d Av Bv"
by (simp add: is_subspace_of_vec_list_def d_def Bo_def)
finally show "ccspan (set A) ≤ ccspan (set B) ⟷ is_subspace_of_vec_list d Av Bv"
by simp
qed
lemma cblinfun_apply_ccspan_using_vec:
"A *⇩S ccspan (set S) = ccspan (basis_enum_of_vec ` set (map ((*⇩v) (mat_of_cblinfun A)) (map vec_of_basis_enum S)))"
apply (auto simp: cblinfun_image_ccspan image_image)
by (metis mat_of_cblinfun_cblinfun_apply vec_of_basis_enum_inverse)
text ‹\<^term>‹mk_projector_orthog d L› takes a list L of d-dimensional vectors
and returns the projector onto the span of L. (Assuming that all vectors in L are
orthogonal and nonzero.)›
fun mk_projector_orthog :: "nat ⇒ complex vec list ⇒ complex mat" where
"mk_projector_orthog d [] = zero_mat d d"
| "mk_projector_orthog d [v] = (let norm2 = cscalar_prod v v in
smult_mat (1/norm2) (mat_of_cols d [v] * mat_of_rows d [conjugate v]))"
| "mk_projector_orthog d (v#vs) = (let norm2 = cscalar_prod v v in
smult_mat (1/norm2) (mat_of_cols d [v] * mat_of_rows d [conjugate v])
+ mk_projector_orthog d vs)"
lemma mk_projector_orthog_correct:
fixes S :: "'a::onb_enum list"
defines "d ≡ length (canonical_basis :: 'a list)"
assumes ortho: "is_ortho_set (set S)" and distinct: "distinct S"
shows "mk_projector_orthog d (map vec_of_basis_enum S)
= mat_of_cblinfun (Proj (ccspan (set S)))"
proof -
define Snorm where "Snorm = map (λs. s /⇩R norm s) S"
have "distinct Snorm"
proof (insert ortho distinct, unfold Snorm_def, induction S)
case Nil
show ?case by simp
next
case (Cons s S)
then have "is_ortho_set (set S)" and "distinct S"
unfolding is_ortho_set_def by auto
note IH = Cons.IH[OF this]
have "s /⇩R norm s ∉ (λs. s /⇩R norm s) ` set S"
proof auto
fix s' assume "s' ∈ set S" and same: "s /⇩R norm s = s' /⇩R norm s'"
with Cons.prems have "s ≠ s'" by auto
have "s ≠ 0"
by (metis Cons.prems(1) is_ortho_set_def list.set_intros(1))
then have "0 ≠ ⟨s /⇩R norm s, s /⇩R norm s⟩"
by simp
also have ‹⟨s /⇩R norm s, s /⇩R norm s⟩ = ⟨s /⇩R norm s, s' /⇩R norm s'⟩›
by (simp add: same)
also have ‹⟨s /⇩R norm s, s' /⇩R norm s'⟩ = ⟨s, s'⟩ / (norm s * norm s')›
by (simp add: scaleR_scaleC divide_inverse_commute)
also from ‹s' ∈ set S› ‹s ≠ s'› have "… = 0"
using Cons.prems unfolding is_ortho_set_def by simp
finally show False
by simp
qed
then show ?case
using IH by simp
qed
have norm_Snorm: "norm s = 1" if "s ∈ set Snorm" for s
using that ortho unfolding Snorm_def is_ortho_set_def apply auto
by (metis left_inverse norm_eq_zero)
have ortho_Snorm: "is_ortho_set (set Snorm)"
unfolding is_ortho_set_def
proof (intro conjI ballI impI)
fix x y
show "0 ∉ set Snorm"
using norm_Snorm[of 0] by auto
assume "x ∈ set Snorm" and "y ∈ set Snorm" and "x ≠ y"
from ‹x ∈ set Snorm›
obtain x' where x: "x = x' /⇩R norm x'" and x': "x' ∈ set S"
unfolding Snorm_def by auto
from ‹y ∈ set Snorm›
obtain y' where y: "y = y' /⇩R norm y'" and y': "y' ∈ set S"
unfolding Snorm_def by auto
from ‹x ≠ y› x y have ‹x' ≠ y'› by auto
with x' y' ortho have "cinner x' y' = 0"
unfolding is_ortho_set_def by auto
then show "cinner x y = 0"
unfolding x y scaleR_scaleC by auto
qed
have inj_butter: "inj_on selfbutter (set Snorm)"
proof (rule inj_onI)
fix x y
assume "x ∈ set Snorm" and "y ∈ set Snorm"
assume "selfbutter x = selfbutter y"
then obtain c where xcy: "x = c *⇩C y" and "cmod c = 1"
using inj_selfbutter_upto_phase by auto
have "0 ≠ cmod (cinner x x)"
using ‹x ∈ set Snorm› norm_Snorm
by force
also have "cmod (cinner x x) = cmod (c * ⟨x, y⟩)"
apply (subst (2) xcy) by simp
also have "… = cmod ⟨x, y⟩"
using ‹cmod c = 1› by (simp add: norm_mult)
finally have "⟨x, y⟩ ≠ 0"
by simp
then show "x = y"
using ortho_Snorm ‹x ∈ set Snorm› ‹y ∈ set Snorm›
unfolding is_ortho_set_def by auto
qed
from ‹distinct Snorm› inj_butter
have distinct': "distinct (map selfbutter Snorm)"
unfolding distinct_map by simp
have Span_Snorm: "ccspan (set Snorm) = ccspan (set S)"
apply (transfer fixing: Snorm S)
apply (simp add: scaleR_scaleC Snorm_def)
apply (subst complex_vector.span_image_scale)
using is_ortho_set_def ortho by fastforce+
have "mk_projector_orthog d (map vec_of_basis_enum S)
= mat_of_cblinfun (sum_list (map selfbutter Snorm))"
unfolding Snorm_def
proof (induction S)
case Nil
show ?case
by (simp add: d_def mat_of_cblinfun_zero)
next
case (Cons a S)
define sumS where "sumS = sum_list (map selfbutter (map (λs. s /⇩R norm s) S))"
with Cons have IH: "mk_projector_orthog d (map vec_of_basis_enum S)
= mat_of_cblinfun sumS"
by simp
define factor where "factor = inverse ((complex_of_real (norm a))⇧2)"
have factor': "factor = 1 / (vec_of_basis_enum a ∙c vec_of_basis_enum a)"
unfolding factor_def cscalar_prod_vec_of_basis_enum
by (simp add: inverse_eq_divide power2_norm_eq_cinner)
have "mk_projector_orthog d (map vec_of_basis_enum (a # S))
= factor ⋅⇩m (mat_of_cols d [vec_of_basis_enum a]
* mat_of_rows d [conjugate (vec_of_basis_enum a)])
+ mat_of_cblinfun sumS"
apply (cases S)
apply (auto simp add: factor' sumS_def d_def mat_of_cblinfun_zero)[1]
by (auto simp add: IH[symmetric] factor' d_def)
also have "… = factor ⋅⇩m (mat_of_cols d [vec_of_basis_enum a] *
mat_adjoint (mat_of_cols d [vec_of_basis_enum a])) + mat_of_cblinfun sumS"
apply (rule arg_cong[where f="λx. _ ⋅⇩m (_ * x) + _"])
apply (rule mat_eq_iff[THEN iffD2])
apply (auto simp add: mat_adjoint_def)
apply (subst mat_of_rows_index) apply auto
apply (subst mat_of_rows_index) apply auto
apply (subst mat_of_cols_index) apply auto
by (simp add: assms(1) dim_vec_of_basis_enum')
also have "… = mat_of_cblinfun (selfbutter (a /⇩R norm a)) + mat_of_cblinfun sumS"
apply (simp add: butterfly_scaleR_left butterfly_scaleR_right power_inverse mat_of_cblinfun_scaleR factor_def)
apply (simp add: butterfly_def mat_of_cblinfun_compose
mat_of_cblinfun_adj mat_of_cblinfun_vector_to_cblinfun d_def)
by (simp add: mat_of_cblinfun_compose mat_of_cblinfun_adj mat_of_cblinfun_vector_to_cblinfun mat_of_cblinfun_scaleC power2_eq_square)
finally show ?case
by (simp add: mat_of_cblinfun_plus sumS_def)
qed
also have "… = mat_of_cblinfun (∑s∈set Snorm. selfbutter s)"
by (metis distinct' distinct_map sum.distinct_set_conv_list)
also have "… = mat_of_cblinfun (∑s∈set Snorm. proj s)"
apply (rule arg_cong[where f="mat_of_cblinfun"])
apply (rule sum.cong[OF refl])
apply (rule butterfly_eq_proj)
using norm_Snorm by simp
also have "… = mat_of_cblinfun (Proj (ccspan (set Snorm)))"
apply (rule arg_cong[of _ _ mat_of_cblinfun])
proof (insert ortho_Snorm, insert ‹distinct Snorm›, induction Snorm)
case Nil
show ?case
by simp
next
case (Cons a Snorm)
from Cons.prems have [simp]: "a ∉ set Snorm"
by simp
have "sum proj (set (a # Snorm))
= proj a + sum proj (set Snorm)"
by auto
also have "… = proj a + Proj (ccspan (set Snorm))"
apply (subst Cons.IH)
using Cons.prems apply auto
by (meson Cons.prems(1) is_ortho_set_antimono set_subset_Cons)
also have "… = Proj (ccspan ({a} ∪ set Snorm))"
apply (rule Proj_orthog_ccspan_union[symmetric])
by (metis Cons.prems(1) ‹a ∉ set Snorm› is_ortho_set_def list.set_intros(1) list.set_intros(2) singleton_iff)
finally show ?case
by simp
qed
also have "… = mat_of_cblinfun (Proj (ccspan (set S)))"
unfolding Span_Snorm by simp
finally show ?thesis
by -
qed
lemma mat_of_cblinfun_Proj_ccspan:
fixes S :: "'a::onb_enum list"
shows "mat_of_cblinfun (Proj (ccspan (set S))) =
(let d = length (canonical_basis :: 'a list) in
mk_projector_orthog d (gram_schmidt0 d (map vec_of_basis_enum S)))"
proof-
define d gs
where "d = length (canonical_basis :: 'a list)"
and "gs = gram_schmidt0 d (map vec_of_basis_enum S)"
interpret complex_vec_space d.
have gs_dim: "x ∈ set gs ⟹ dim_vec x = d" for x
by (smt carrier_vecD carrier_vec_dim_vec d_def dim_vec_of_basis_enum' ex_map_conv gram_schmidt0_result(1) gs_def subset_code(1))
have ortho_gs: "is_ortho_set (set (map basis_enum_of_vec gs :: 'a list))"
apply (subst corthogonal_vec_of_basis_enum[THEN iffD1], auto)
by (smt carrier_dim_vec cof_vec_space.gram_schmidt0_result(1) d_def dim_vec_of_basis_enum' gram_schmidt0_result(3) gs_def imageE map_idI map_map o_apply set_map subset_code(1) basis_enum_of_vec_inverse)
have distinct_gs: "distinct (map basis_enum_of_vec gs :: 'a list)"
by (metis (mono_tags, hide_lams) carrier_vec_dim_vec cof_vec_space.gram_schmidt0_result(2) d_def dim_vec_of_basis_enum' distinct_map gs_def gs_dim image_iff inj_on_inverseI set_map subsetI basis_enum_of_vec_inverse)
have "mk_projector_orthog d gs
= mk_projector_orthog d (map vec_of_basis_enum (map basis_enum_of_vec gs :: 'a list))"
apply simp
apply (subst map_cong[where ys=gs and g=id], simp)
using gs_dim by (auto intro!: vec_of_basis_enum_inverse simp: d_def)
also have "… = mat_of_cblinfun (Proj (ccspan (set (map basis_enum_of_vec gs :: 'a list))))"
unfolding d_def
apply (subst mk_projector_orthog_correct)
using ortho_gs distinct_gs by auto
also have "… = mat_of_cblinfun (Proj (ccspan (set S)))"
apply (rule arg_cong[where f="λx. mat_of_cblinfun (Proj x)"])
unfolding gs_def d_def
apply (subst ccspan_gram_schmidt0_invariant)
by (auto simp add: carrier_vecI dim_vec_of_basis_enum')
finally show ?thesis
unfolding d_def gs_def by auto
qed
unbundle no_jnf_notation
unbundle no_cblinfun_notation
end
Theory Cblinfun_Code
section ‹‹Cblinfun_Code› -- Support for code generation›
text ‹This theory provides support for code generation involving on complex vector spaces and
bounded operators (e.g., types ‹cblinfun› and ‹ell2›).
To fully support code generation, in addition to importing this theory,
one need to activate support for code generation (import theory ‹Jordan_Normal_Form.Matrix_Impl›)
and for real and complex numbers (import theory ‹Real_Impl.Real_Impl› for support of reals of the
form ‹a + b * sqrt c› or ‹Algebraic_Numbers.Real_Factorization› (much slower) for support of algebraic reals;
support of complex numbers comes "for free").
The builtin support for real and complex numbers (in ‹Complex_Main›) is not sufficient because it
does not support the computation of square-roots which are used in the setup below.
It is also recommended to import ‹HOL-Library.Code_Target_Numeral› for faster support of nats
and integers.›
theory Cblinfun_Code
imports
Cblinfun_Matrix Containers.Set_Impl Jordan_Normal_Form.Matrix_Kernel
begin
no_notation "Lattice.meet" (infixl "⊓ı" 70)
no_notation "Lattice.join" (infixl "⊔ı" 65)
hide_const (open) Coset.kernel
hide_const (open) Matrix_Kernel.kernel
hide_const (open) Order.bottom Order.top
unbundle jnf_notation
unbundle cblinfun_notation
subsection ‹Code equations for cblinfun operators›
text ‹In this subsection, we define the code for all operations involving only
operators (no combinations of operators/vectors/subspaces)›
text ‹The following lemma registers cblinfun as an abstract datatype with
constructor \<^const>‹cblinfun_of_mat›.
That means that in generated code, all cblinfun operators will be represented
as \<^term>‹cblinfun_of_mat X› where X is a matrix.
In code equations for operations involving operators (e.g., +), we
can then write the equation directly in terms of matrices
by writing, e.g., \<^term>‹mat_of_cblinfun (A+B)› in the lhs,
and in the rhs we define the matrix that corresponds to the sum of A,B.
In the rhs, we can access the matrices corresponding to A,B by
writing \<^term>‹mat_of_cblinfun B›.
(See, e.g., lemma ‹cblinfun_of_mat_plusOp› below).
See @{cite "code-generation-tutorial"} for more information on
@{theory_text ‹[code abstype]›}.›
declare mat_of_cblinfun_inverse [code abstype]
text ‹This lemma defines addition. By writing \<^term>‹mat_of_cblinfun (M + N)›
on the left hand side, we get access to the›
declare mat_of_cblinfun_plus[code]
declare mat_of_cblinfun_id[code]
declare mat_of_cblinfun_1[code]
declare mat_of_cblinfun_zero[code]
declare mat_of_cblinfun_uminus[code]
declare mat_of_cblinfun_minus[code]
declare mat_of_cblinfun_classical_operator[code]
declare mat_of_cblinfun_compose[code]
declare mat_of_cblinfun_scaleC[code]
declare mat_of_cblinfun_scaleR[code]
declare mat_of_cblinfun_adj[code]
text ‹This instantiation defines a code equation for equality tests for cblinfun.›
instantiation cblinfun :: (onb_enum,onb_enum) equal begin
definition [code]: "equal_cblinfun M N ⟷ mat_of_cblinfun M = mat_of_cblinfun N"
for M N :: "'a ⇒⇩C⇩L 'b"
instance
apply intro_classes
unfolding equal_cblinfun_def
using mat_of_cblinfun_inj injD by fastforce
end
subsection ‹Vectors›
text ‹In this section, we define code for operations on vectors. As with operators above,
we do this by using an isomorphism between finite vectors
(i.e., types T of sort ‹complex_vector›) and the type \<^typ>‹complex vec› from
\<^session>‹Jordan_Normal_Form›. We have developed such an isomorphism in
\<^theory>‹Complex_Bounded_Operators.Cblinfun_Matrix› for
any type T of sort ‹onb_enum› (i.e., any type with a finite canonical orthonormal basis)
as was done above for bounded operators.
Unfortunately, we cannot declare code equations for a type class,
code equations must be related to a specific type constructor.
So we give code definition only for vectors of type \<^typ>‹'a ell2› (where \<^typ>‹'a›
must be of sort ‹enum› to make make sure that \<^typ>‹'a ell2› is finite dimensional).
The isomorphism between \<^typ>‹'a ell2› is given by the constants ‹ell2_of_vec›
and ‹vec_of_ell2› which are copies of the more general \<^const>‹basis_enum_of_vec›
and \<^const>‹vec_of_basis_enum› but with a more restricted type to be usable in our code equations.
›
definition ell2_of_vec :: "complex vec ⇒ 'a::enum ell2" where "ell2_of_vec = basis_enum_of_vec"
definition vec_of_ell2 :: "'a::enum ell2 ⇒ complex vec" where "vec_of_ell2 = vec_of_basis_enum"
text ‹The following theorem registers the isomorphism ‹ell2_of_vec›/‹vec_of_ell2›
for code generation. From now on,
code for operations on \<^typ>‹_ ell2› can be expressed by declarations such
as \<^term>‹vec_of_ell2 (f a b) = g (vec_of_ell2 a) (vec_of_ell2 b)›
if the operation f on \<^typ>‹_ ell2› corresponds to the operation g on
\<^typ>‹complex vec›.›
lemma vec_of_ell2_inverse [code abstype]:
"ell2_of_vec (vec_of_ell2 B) = B"
unfolding ell2_of_vec_def vec_of_ell2_def
by (rule vec_of_basis_enum_inverse)
text ‹This instantiation defines a code equation for equality tests for ell2.›
instantiation ell2 :: (enum) equal begin
definition [code]: "equal_ell2 M N ⟷ vec_of_ell2 M = vec_of_ell2 N"
for M N :: "'a::enum ell2"
instance
apply intro_classes
unfolding equal_ell2_def
by (metis vec_of_ell2_inverse)
end
lemma vec_of_ell2_zero[code]:
"vec_of_ell2 (0::'a::enum ell2) = zero_vec (CARD('a))"
by (simp add: vec_of_ell2_def vec_of_basis_enum_zero)
lemma vec_of_ell2_ket[code]:
"vec_of_ell2 (ket i) = unit_vec (CARD('a)) (enum_idx i)"
for i::"'a::enum"
using vec_of_ell2_def vec_of_basis_enum_ket by metis
lemma vec_of_ell2_timesScalarVec[code]:
"vec_of_ell2 (scaleC a ψ) = smult_vec a (vec_of_ell2 ψ)"
for ψ :: "'a::enum ell2"
by (simp add: vec_of_ell2_def vec_of_basis_enum_scaleC)
lemma vec_of_ell2_scaleR[code]:
"vec_of_ell2 (scaleR a ψ) = smult_vec (complex_of_real a) (vec_of_ell2 ψ)"
for ψ :: "'a::enum ell2"
by (simp add: vec_of_ell2_def vec_of_basis_enum_scaleR)
lemma ell2_of_vec_plus[code]:
"vec_of_ell2 (x + y) = (vec_of_ell2 x) + (vec_of_ell2 y)" for x y :: "'a::enum ell2"
by (simp add: vec_of_ell2_def vec_of_basis_enum_add)
lemma ell2_of_vec_minus[code]:
"vec_of_ell2 (x - y) = (vec_of_ell2 x) - (vec_of_ell2 y)" for x y :: "'a::enum ell2"
by (simp add: vec_of_ell2_def vec_of_basis_enum_minus)
lemma ell2_of_vec_uminus[code]:
"vec_of_ell2 (- y) = - (vec_of_ell2 y)" for y :: "'a::enum ell2"
by (simp add: vec_of_ell2_def vec_of_basis_enum_uminus)
lemma cinner_ell2_code' [code]: "cinner ψ φ = cscalar_prod (vec_of_ell2 φ) (vec_of_ell2 ψ)"
by (simp add: cscalar_prod_vec_of_basis_enum vec_of_ell2_def)
lemma norm_ell2_code [code]:
"norm ψ = (let ψ' = vec_of_ell2 ψ in
sqrt (∑ i ∈ {0 ..< dim_vec ψ'}. let z = vec_index ψ' i in (Re z)⇧2 + (Im z)⇧2))"
by (simp add: norm_ell2_vec_of_basis_enum vec_of_ell2_def)
lemma times_ell2_code'[code]:
fixes ψ φ :: "'a::{CARD_1,enum} ell2"
shows "vec_of_ell2 (ψ * φ)
= vec_of_list [vec_index (vec_of_ell2 ψ) 0 * vec_index (vec_of_ell2 φ) 0]"
by (simp add: vec_of_ell2_def vec_of_basis_enum_times)
lemma divide_ell2_code'[code]:
fixes ψ φ :: "'a::{CARD_1,enum} ell2"
shows "vec_of_ell2 (ψ / φ)
= vec_of_list [vec_index (vec_of_ell2 ψ) 0 / vec_index (vec_of_ell2 φ) 0]"
by (simp add: vec_of_ell2_def vec_of_basis_enum_divide)
lemma inverse_ell2_code'[code]:
fixes ψ :: "'a::{CARD_1,enum} ell2"
shows "vec_of_ell2 (inverse ψ)
= vec_of_list [inverse (vec_index (vec_of_ell2 ψ) 0)]"
by (simp add: vec_of_ell2_def vec_of_basis_enum_to_inverse)
lemma one_ell2_code'[code]:
"vec_of_ell2 (1 :: 'a::{CARD_1,enum} ell2) = vec_of_list [1]"
by (simp add: vec_of_ell2_def vec_of_basis_enum_1)
subsection ‹Vector/Matrix›
text ‹We proceed to give code equations for operations involving both
operators (cblinfun) and vectors. As explained above, we have to restrict
the equations to vectors of type \<^typ>‹'a ell2› even though the theory is available
for any type of class \<^class>‹onb_enum›. As a consequence, we run into an
addition technicality now. For example, to define a code equation for applying
an operator to a vector, we might try to give the following lemma:
⬚‹lemma cblinfun_apply_code[code]:
"vec_of_ell2 (M *⇩V x) = (mult_mat_vec (mat_of_cblinfun M) (vec_of_ell2 x))"
by (simp add: mat_of_cblinfun_cblinfun_apply vec_of_ell2_def)›
Unfortunately, this does not work, Isabelle produces the warning
"Projection as head in equation", most likely due to the fact that
the type of \<^term>‹(*⇩V)› in the equation is less general than the type of
\<^term>‹(*⇩V)› (it is restricted to @{type ell2}). We overcome this problem
by defining a constant ‹cblinfun_apply_code› which is equal to \<^term>‹(*⇩V)›
but has a more restricted type. We then instruct the code generation
to replace occurrences of \<^term>‹(*⇩V)› by ‹cblinfun_apply_code› (where possible),
and we add code generation for ‹cblinfun_apply_code› instead of \<^term>‹(*⇩V)›.
›
definition cblinfun_apply_code :: "'a ell2 ⇒⇩C⇩L 'b ell2 ⇒ 'a ell2 ⇒ 'b ell2"
where [code del, code_abbrev]: "cblinfun_apply_code = (*⇩V)"
lemma cblinfun_apply_code[code]:
"vec_of_ell2 (cblinfun_apply_code M x) = (mult_mat_vec (mat_of_cblinfun M) (vec_of_ell2 x))"
by (simp add: cblinfun_apply_code_def mat_of_cblinfun_cblinfun_apply vec_of_ell2_def)
text ‹For the constant \<^term>‹vector_to_cblinfun› (canonical isomorphism from
vectors to operators), we have the same problem and define a constant
‹vector_to_cblinfun_code› with more restricted type›
definition vector_to_cblinfun_code :: "'a ell2 ⇒ 'b::one_dim ⇒⇩C⇩L 'a ell2" where
[code del,code_abbrev]: "vector_to_cblinfun_code = vector_to_cblinfun"
lemma vector_to_cblinfun_code[code]:
"mat_of_cblinfun (vector_to_cblinfun_code ψ) = mat_of_cols (CARD('a)) [vec_of_ell2 ψ]"
for ψ::"'a::enum ell2"
by (simp add: mat_of_cblinfun_vector_to_cblinfun vec_of_ell2_def vector_to_cblinfun_code_def)
subsection ‹Subspaces›
text ‹In this section, we define code equations for handling subspaces, i.e.,
values of type \<^typ>‹'a ccsubspace›. We choose to computationally represent
a subspace by a list of vectors that span the subspace. That is,
if \<^term>‹vecs› are vectors (type \<^typ>‹complex vec›), ‹SPAN vecs› is defined to be their
span. Then the code generation can simply represent all subspaces in this form, and
we need to define the operations on subspaces in terms of list of vectors
(e.g., the closed union of two subspaces would be computed as the concatenation
of the two lists, to give one of the simplest examples).
To support this, ‹SPAN› is declared as a "‹code_datatype›".
(Not as an abstract datatype like \<^term>‹cblinfun_of_mat›/\<^term>‹mat_of_cblinfun›
because that would require ‹SPAN› to be injective.)
Then all code equations for different operations need to be formulated as
functions of values of the form ‹SPAN x›. (E.g., ‹SPAN x + SPAN y = SPAN (…)›.)›
definition [code del]: "SPAN x = (let n = length (canonical_basis :: 'a::onb_enum list) in
ccspan (basis_enum_of_vec ` Set.filter (λv. dim_vec v = n) (set x)) :: 'a ccsubspace)"
code_datatype SPAN
text ‹We first declare code equations for \<^term>‹Proj›, i.e., for
turning a subspace into a projector. This means, we would need a code equation
of the form ‹mat_of_cblinfun (Proj (SPAN S)) = …›. However, this equation is
not accepted by the code generation for reasons we do not understand. But
if we define an auxiliary constant ‹mat_of_cblinfun_Proj_code› that stands for
‹mat_of_cblinfun (Proj _)›, define a code equation for ‹mat_of_cblinfun_Proj_code›,
and then define a code equation for ‹mat_of_cblinfun (Proj S)› in terms of
‹mat_of_cblinfun_Proj_code›, Isabelle accepts the code equations.›
definition "mat_of_cblinfun_Proj_code S = mat_of_cblinfun (Proj S)"
declare mat_of_cblinfun_Proj_code_def[symmetric, code]
lemma mat_of_cblinfun_Proj_code_code[code]:
"mat_of_cblinfun_Proj_code (SPAN S :: 'a::onb_enum ccsubspace) =
(let d = length (canonical_basis :: 'a list) in mk_projector_orthog d
(gram_schmidt0 d (filter (λv. dim_vec v = d) S)))"
proof -
have *: "map_option vec_of_basis_enum (if dim_vec x = length (canonical_basis :: 'a list) then Some (basis_enum_of_vec x :: 'a) else None)
= (if dim_vec x = length (canonical_basis :: 'a list) then Some x else None)" for x
by auto
show ?thesis
unfolding SPAN_def mat_of_cblinfun_Proj_code_def
using mat_of_cblinfun_Proj_ccspan[where S =
"map basis_enum_of_vec (filter (λv. dim_vec v = (length (canonical_basis :: 'a list))) S) :: 'a list"]
apply (simp only: Let_def map_filter_map_filter filter_set image_set map_map_filter o_def)
unfolding *
by (simp add: map_filter_map_filter[symmetric])
qed
lemma top_ccsubspace_code[code]:
"(top::'a ccsubspace) =
(let n = length (canonical_basis :: 'a::onb_enum list) in SPAN (unit_vecs n))"
unfolding SPAN_def
apply (simp only: index_unit_vec Let_def map_filter_map_filter filter_set image_set map_map_filter
map_filter_map o_def unit_vecs_def)
apply (simp add: basis_enum_of_vec_unit_vec)
apply (subst nth_image)
by (auto simp: )
lemma bot_as_span[code]:
"(bot::'a::onb_enum ccsubspace) = SPAN []"
unfolding SPAN_def by (auto simp: Set.filter_def)
lemma sup_spans[code]:
"SPAN A ⊔ SPAN B = SPAN (A @ B)"
unfolding SPAN_def
by (auto simp: ccspan_union image_Un filter_Un Let_def)
text ‹We do not need an equation for \<^term>‹(+)› because \<^term>‹(+)›
is defined in terms of \<^term>‹(⊔)› (for \<^type>‹ccsubspace›), thus the code generation automatically
computes \<^term>‹(+)› in terms of the code for \<^term>‹(⊔)››
definition [code del,code_abbrev]: "Span_code (S::'a::enum ell2 set) = (ccspan S)"
lemma span_Set_Monad[code]: "Span_code (Set_Monad l) = (SPAN (map vec_of_ell2 l))"
apply (simp add: Span_code_def SPAN_def Let_def)
apply (subst Set_filter_unchanged)
apply (auto simp add: vec_of_ell2_def)[1]
by (metis (no_types, lifting) ell2_of_vec_def image_image map_idI set_map vec_of_ell2_inverse)
text ‹This instantiation defines a code equation for equality tests for \<^type>‹ccsubspace›.
The actual code for equality tests is given below (lemma ‹equal_ccsubspace_code›).›
instantiation ccsubspace :: (onb_enum) equal begin
definition [code del]: "equal_ccsubspace (A::'a ccsubspace) B = (A=B)"
instance apply intro_classes unfolding equal_ccsubspace_def by simp
end
lemma leq_ccsubspace_code[code]:
"SPAN A ≤ (SPAN B :: 'a::onb_enum ccsubspace)
⟷ (let d = length (canonical_basis :: 'a list) in
is_subspace_of_vec_list d
(filter (λv. dim_vec v = d) A)
(filter (λv. dim_vec v = d) B))"
proof -
define d A' B' where "d = length (canonical_basis :: 'a list)"
and "A' = filter (λv. dim_vec v = d) A"
and "B' = filter (λv. dim_vec v = d) B"
show ?thesis
unfolding SPAN_def d_def[symmetric] filter_set Let_def
A'_def[symmetric] B'_def[symmetric] image_set
apply (subst ccspan_leq_using_vec)
unfolding d_def[symmetric] map_map o_def
apply (subst map_cong[where xs=A', OF refl])
apply (rule basis_enum_of_vec_inverse)
apply (simp add: A'_def d_def)
apply (subst map_cong[where xs=B', OF refl])
apply (rule basis_enum_of_vec_inverse)
by (simp_all add: B'_def d_def)
qed
lemma equal_ccsubspace_code[code]:
"HOL.equal (A::_ ccsubspace) B = (A≤B ∧ B≤A)"
unfolding equal_ccsubspace_def by auto
lemma apply_cblinfun_code[code]:
"A *⇩S SPAN S = (let d = length (canonical_basis :: 'a list) in
SPAN (map (mult_mat_vec (mat_of_cblinfun A))
(filter (λv. dim_vec v = d) S)))"
for A::"'a::onb_enum ⇒⇩C⇩L'b::onb_enum"
proof -
define dA dB S'
where "dA = length (canonical_basis :: 'a list)"
and "dB = length (canonical_basis :: 'b list)"
and "S' = filter (λv. dim_vec v = dA) S"
have "cblinfun_image A (SPAN S) = A *⇩S ccspan (set (map basis_enum_of_vec S'))"
unfolding SPAN_def dA_def[symmetric] Let_def S'_def filter_set
by simp
also have "… = ccspan ((λx. basis_enum_of_vec
(mat_of_cblinfun A *⇩v vec_of_basis_enum (basis_enum_of_vec x :: 'a))) ` set S')"
apply (subst cblinfun_apply_ccspan_using_vec)
by (simp add: image_image)
also have "… = ccspan ((λx. basis_enum_of_vec (mat_of_cblinfun A *⇩v x)) ` set S')"
apply (subst image_cong[OF refl])
apply (subst basis_enum_of_vec_inverse)
by (auto simp add: S'_def dA_def)
also have "… = SPAN (map (mult_mat_vec (mat_of_cblinfun A)) S')"
unfolding SPAN_def dB_def[symmetric] Let_def filter_set
apply (subst filter_True)
by (simp_all add: dB_def mat_of_cblinfun_def image_image)
finally show ?thesis
unfolding dA_def[symmetric] S'_def[symmetric] Let_def
by simp
qed
definition [code del, code_abbrev]: "range_cblinfun_code A = A *⇩S top"
lemma range_cblinfun_code[code]:
fixes A :: "'a::onb_enum ⇒⇩C⇩L 'b::onb_enum"
shows "range_cblinfun_code A = SPAN (cols (mat_of_cblinfun A))"
proof -
define dA dB
where "dA = length (canonical_basis :: 'a list)"
and "dB = length (canonical_basis :: 'b list)"
have carrier_A: "mat_of_cblinfun A ∈ carrier_mat dB dA"
unfolding mat_of_cblinfun_def dA_def dB_def by simp
have "range_cblinfun_code A = A *⇩S SPAN (unit_vecs dA)"
unfolding range_cblinfun_code_def
by (metis dA_def top_ccsubspace_code)
also have "… = SPAN (map (λi. mat_of_cblinfun A *⇩v unit_vec dA i) [0..<dA])"
unfolding apply_cblinfun_code dA_def[symmetric] Let_def
apply (subst filter_True)
apply (meson carrier_vecD subset_code(1) unit_vecs_carrier)
by (simp add: unit_vecs_def o_def)
also have "… = SPAN (map (λx. mat_of_cblinfun A *⇩v col (1⇩m dA) x) [0..<dA])"
apply (subst map_cong[OF refl])
by auto
also have "… = SPAN (map (col (mat_of_cblinfun A * 1⇩m dA)) [0..<dA])"
apply (subst map_cong[OF refl])
apply (subst col_mult2[symmetric])
apply (rule carrier_A)
by auto
also have "… = SPAN (cols (mat_of_cblinfun A))"
unfolding cols_def dA_def[symmetric]
apply (subst right_mult_one_mat[OF carrier_A])
using carrier_A by blast
finally show ?thesis
by -
qed
lemma uminus_Span_code[code]: "- X = range_cblinfun_code (id_cblinfun - Proj X)"
unfolding range_cblinfun_code_def
by (metis Proj_ortho_compl Proj_range)
lemma kernel_code[code]:
"kernel A = SPAN (find_base_vectors (gauss_jordan_single (mat_of_cblinfun A)))"
for A::"('a::onb_enum,'b::onb_enum) cblinfun"
proof -
define dA dB Am Ag base
where "dA = length (canonical_basis :: 'a list)"
and "dB = length (canonical_basis :: 'b list)"
and "Am = mat_of_cblinfun A"
and "Ag = gauss_jordan_single Am"
and "base = find_base_vectors Ag"
interpret complex_vec_space dA.
have Am_carrier: "Am ∈ carrier_mat dB dA"
unfolding Am_def mat_of_cblinfun_def dA_def dB_def by simp
have row_echelon: "row_echelon_form Ag"
unfolding Ag_def
using Am_carrier refl by (rule gauss_jordan_single)
have Ag_carrier: "Ag ∈ carrier_mat dB dA"
unfolding Ag_def
using Am_carrier refl by (rule gauss_jordan_single(2))
have base_carrier: "set base ⊆ carrier_vec dA"
unfolding base_def
using find_base_vectors(1)[OF row_echelon Ag_carrier]
using Ag_carrier mat_kernel_def by blast
interpret k: kernel dB dA Ag
apply standard using Ag_carrier by simp
have basis_base: "kernel.basis dA Ag (set base)"
using row_echelon Ag_carrier unfolding base_def
by (rule find_base_vectors(3))
have "space_as_set (SPAN base)
= space_as_set (ccspan (basis_enum_of_vec ` set base :: 'a set))"
unfolding SPAN_def dA_def[symmetric] Let_def filter_set
apply (subst filter_True)
using base_carrier by auto
also have "… = cspan (basis_enum_of_vec ` set base)"
apply transfer apply (subst closure_finite_cspan)
by simp_all
also have "… = basis_enum_of_vec ` span (set base)"
apply (subst basis_enum_of_vec_span)
using base_carrier dA_def by auto
also have "… = basis_enum_of_vec ` mat_kernel Ag"
using basis_base k.Ker.basis_def k.span_same by auto
also have "… = basis_enum_of_vec ` {v ∈ carrier_vec dA. Ag *⇩v v = 0⇩v dB}"
apply (rule arg_cong[where f="λx. basis_enum_of_vec ` x"])
unfolding mat_kernel_def using Ag_carrier
by simp
also have "… = basis_enum_of_vec ` {v ∈ carrier_vec dA. Am *⇩v v = 0⇩v dB}"
using gauss_jordan_single(1)[OF Am_carrier Ag_def[symmetric]]
by auto
also have "… = {w. A *⇩V w = 0}"
proof -
have "basis_enum_of_vec ` {v ∈ carrier_vec dA. Am *⇩v v = 0⇩v dB}
= basis_enum_of_vec ` {v ∈ carrier_vec dA. A *⇩V basis_enum_of_vec v = 0}"
apply (rule arg_cong[where f="λt. basis_enum_of_vec ` t"])
apply (rule Collect_cong)
apply (simp add: Am_def)
by (metis Am_carrier Am_def carrier_matD(2) carrier_vecD dB_def mat_carrier
mat_of_cblinfun_def mat_of_cblinfun_cblinfun_apply vec_of_basis_enum_inverse
basis_enum_of_vec_inverse vec_of_basis_enum_zero)
also have "… = {w ∈ basis_enum_of_vec ` carrier_vec dA. A *⇩V w = 0}"
apply (subst Compr_image_eq[symmetric])
by simp
also have "… = {w. A *⇩V w = 0}"
apply auto
by (metis (no_types, lifting) Am_carrier Am_def carrier_matD(2) carrier_vec_dim_vec dim_vec_of_basis_enum' image_iff mat_carrier mat_of_cblinfun_def vec_of_basis_enum_inverse)
finally show ?thesis
by -
qed
also have "… = space_as_set (kernel A)"
apply transfer by auto
finally have "SPAN base = kernel A"
by (simp add: space_as_set_inject)
then show ?thesis
by (simp add: base_def Ag_def Am_def)
qed
lemma inf_ccsubspace_code[code]:
"(A::'a::onb_enum ccsubspace) ⊓ B = - (- A ⊔ - B)"
by (subst ortho_involution[symmetric], subst compl_inf, simp)
lemma Sup_ccsubspace_code[code]:
"Sup (Set_Monad l :: 'a::onb_enum ccsubspace set) = fold sup l bot"
unfolding Set_Monad_def
by (simp add: Sup_set_fold)
lemma Inf_ccsubspace_code[code]:
"Inf (Set_Monad l :: 'a::onb_enum ccsubspace set)
= - Sup (Set_Monad (map uminus l))"
unfolding Set_Monad_def
apply (induction l)
by auto
subsection ‹Miscellanea›
text ‹This is a hack to circumvent a bug in the code generation. The automatically
generated code for the class \<^class>‹uniformity› has a type that is different from
what the generated code later assumes, leading to compilation errors (in ML at least)
in any expression involving \<^typ>‹_ ell2› (even if the constant \<^const>‹uniformity› is
not actually used).
The fragment below circumvents this by forcing Isabelle to use the right type.
(The logically useless fragment "‹let x = ((=)::'a⇒_⇒_)›" achieves this.)›
lemma uniformity_ell2_code[code]: "(uniformity :: ('a ell2 * _) filter) = Filter.abstract_filter (%_.
Code.abort STR ''no uniformity'' (%_.
let x = ((=)::'a⇒_⇒_) in uniformity))"
by simp
text ‹Code equation for \<^term>‹UNIV›.
It is now implemented via type class \<^class>‹enum›
(which provides a list of all values).›
declare [[code drop: UNIV]]
declare enum_class.UNIV_enum[code]
text ‹Setup for code generation involving sets of \<^type>‹ell2›/\<^type>‹ccsubspace›.
This configures to use lists for representing sets in code.›
derive (eq) ceq ccsubspace
derive (no) ccompare ccsubspace
derive (monad) set_impl ccsubspace
derive (eq) ceq ell2
derive (no) ccompare ell2
derive (monad) set_impl ell2
unbundle no_jnf_notation
unbundle no_cblinfun_notation
end
Theory Cblinfun_Code_Examples
section ‹‹Cblinfun_Code_Examples› -- Examples and test cases for code generation›
theory Cblinfun_Code_Examples
imports
"Complex_Bounded_Operators.Extra_Pretty_Code_Examples"
Jordan_Normal_Form.Matrix_Impl
"HOL-Library.Code_Target_Numeral"
Cblinfun_Code
begin
hide_const (open) Order.bottom Order.top
no_notation Lattice.join (infixl "⊔ı" 65)
no_notation Lattice.meet (infixl "⊓ı" 70)
unbundle cblinfun_notation
section ‹Examples›
subsection ‹Operators›
value "id_cblinfun :: bool ell2 ⇒⇩C⇩L bool ell2"
value "1 :: unit ell2 ⇒⇩C⇩L unit ell2"
value "id_cblinfun + id_cblinfun :: bool ell2 ⇒⇩C⇩L bool ell2"
value "0 :: (bool ell2 ⇒⇩C⇩L Enum.finite_3 ell2)"
value "- id_cblinfun :: bool ell2 ⇒⇩C⇩L bool ell2"
value "id_cblinfun - id_cblinfun :: bool ell2 ⇒⇩C⇩L bool ell2"
value "classical_operator (λb. Some (¬ b))"
value "id_cblinfun = (0 :: bool ell2 ⇒⇩C⇩L bool ell2)"
value "2 *⇩R id_cblinfun :: bool ell2 ⇒⇩C⇩L bool ell2"
value "imaginary_unit *⇩C id_cblinfun :: bool ell2 ⇒⇩C⇩L bool ell2"
value "id_cblinfun o⇩C⇩L 0 :: bool ell2 ⇒⇩C⇩L bool ell2"
value "id_cblinfun* :: bool ell2 ⇒⇩C⇩L bool ell2"
subsection ‹Vectors›
value "0 :: bool ell2"
value "1 :: unit ell2"
value "ket False"
value "2 *⇩C ket False"
value "2 *⇩R ket False"
value "ket True + ket False"
value "ket True - ket True"
value "ket True = ket True"
value "- ket True"
value "cinner (ket True) (ket True)"
value "norm (ket True)"
value "ket () * ket ()"
value "1 :: unit ell2"
value "(1::unit ell2) * (1::unit ell2)"
subsection ‹Vector/Matrix›
value "id_cblinfun *⇩V ket True"
value ‹vector_to_cblinfun (ket True) :: unit ell2 ⇒⇩C⇩L _›
subsection ‹Subspaces›
value "ccspan {ket False}"
value "Proj (ccspan {ket False})"
value "top :: bool ell2 ccsubspace"
value "bot :: bool ell2 ccsubspace"
value "0 :: bool ell2 ccsubspace"
value "ccspan {ket False} ⊔ ccspan {ket True}"
value "ccspan {ket False} + ccspan {ket True}"
value "ccspan {ket False} ⊓ ccspan {ket True}"
value "id_cblinfun *⇩S ccspan {ket False}"
value "id_cblinfun *⇩S (top :: bool ell2 ccsubspace)"
value "- ccspan {ket False}"
value "ccspan {ket False, ket True} = top"
value "ccspan {ket False} ≤ ccspan {ket True}"
value "cblinfun_image id_cblinfun (ccspan {ket True})"
value "kernel id_cblinfun :: bool ell2 ccsubspace"
value "eigenspace 1 id_cblinfun :: bool ell2 ccsubspace"
value "Inf {ccspan {ket False}, top}"
value "Sup {ccspan {ket False}, top}"
end